perm filename TEST1.LST[HAL,HE] blob
sn#155550 filedate 1975-04-21 generic text, type T, neo UTF8
PALX 222 04/21/75 21:12:45 PAGE 1
TEST1 PAL[HAL,HE] PAGE 1
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 GENERAL PURPOSE TEST ROUTINE USING THE KERNEL
C00004 00003 FLREAD, SCALIN, VECTIN, TRNSIN, SCLOUT, VECOUT, TRNOUT
C00010 00004 program initialization
C00014 ENDMK
C⊗;
PALX 222 04/21/75 21:12:45 PAGE 2
TEST1 PAL[HAL,HE] PAGE 2
;GENERAL PURPOSE TEST ROUTINE USING THE KERNEL
.MACRO SYSDEF ADR, CONTEN
III == .
. = ADR
CONTEN
. = III
.ENDM
.INSRT KDEF.PAL[11,SYS]
PALX 222 04/21/75 21:12:45 PAGE 3
KDEF PAL[11,SYS] PAGE 1
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 To get these definitions in your program, I recommend
C00007 00003 DEFINITIONS OF SYSTEM CALLS
C00014 00004 Loading and running your program with this system
C00017 ENDMK
C⊗;
PALX 222 04/21/75 21:12:45 PAGE 4
KDEF PAL[11,SYS] PAGE 2
COMMENT⊗ To get these definitions in your program, I recommend
this sequence:
.XLIST
.INSRT KDEF.PAL[11,SYS]
.LIST
PROCESS DESCRIPTOR BLOCKS
These blocks, one for each active process, contain all of the
state of the process. For now, I'll let you allocate them in
your own address space, but if there is enough demand for the
service I can make the Kernel do the allocation.
The format of these blocks is:
0, 40, or 70 (octal) bytes for the floating-point registers
and status, depending on whether the process uses floating point
and double precision. This part is below the base address of
the block. The words at block-6 and block-4 are used by the
floating point trap routine to store the Floating Exception Code
and Floating Exception Address (see the FPP description in the
11/45 handbook). You can test these locations to find out
about overflow and the like.
The rest of the block is the same for all processes:
Words 0-7 contain miscellaneous information used by the Kernel
(more about this later).
Words 10-20 hold the general registers, stack pointer, PC, and PS
when the process is inactive.
Word 21 contains information used to figure out how much stuff
the process has on its stack when it is being suspended.
Word 22 contains the length of the area where the stack will be
saved. A horrendous error will happen if a process tries
to suspend itself with more than this amount on its stack.
Words 23 on are the area where the stack will be saved.
Word 0 contains the following status bits of interest to the user:
⊗
100000 UFPUSE==100000 ;He uses floating point.
040000 UDPUSE==040000 ;He uses double precision.
020000 UFPNSV==020000 ;He doesn't want his floating point registers
;saved when he suspends himself.
010000 USKNSV==010000 ;Ditto the stack.
000200 UFPSAV==000200 ;His FP rgisters have been saved.
000100 UGPSAV==000100 ;Ditto his general registers
PALX 222 04/21/75 21:12:45 PAGE 5
KDEF PAL[11,SYS] PAGE 2.1
000040 USKOK ==000040 ;On means stack OK (was interrupted)
COMMENT⊗ The following macro is for your convenience in reserving
space for these blocks. NAM is the label to put at the base location,
LPDL is the maximum length of the stack to be saved whenever the process
suspends itself. FP is either omitted (no floating point) or the letter
D (double precision) or anything else for single precision. If you
specify double precision you may of course switch back and forth between
single and double. This parameter merely controls how much space is
allocated for saving the registers. FPS, if present, causes UFPNSV to
be turned on, and SKS does the same for USKNSV. You can use just about
any non-blank thing for these two operands.
⊗
000040 FPOFF==40 ;Single precision data length
000070 DPOFF==70 ;Double precision length
000000 UST0==0
000044 USKLEN==44
.MACRO PDBLK NAM,LPDL,FP,FPS,SKS
.IF NB FP
.W.==UFPUSE
.IF IDN <FP>,<D>
.BLKW DPOFF
.W.==.W.+UDPUSE
.IFF
.BLKW FPOFF
.ENDC
.IFF
.W.==0
.ENDC
.LIF NB FPS
.W.==.W.+UFPNSV
.LIF NB SKS
.W.==.W.+USKNSV
NAM: .WORD .W.
.BLKW <USKLEN-UST0>/2-1
.WORD LPDL
.BLKW LPDL
.ENDM
PALX 222 04/21/75 21:12:45 PAGE 6
KDEF PAL[11,SYS] PAGE 3
; DEFINITIONS OF SYSTEM CALLS
COMMENT⊗ The way these operations handle their arguments
may be somewhat confusing, so I'll explain here. All arguments
are pushed onto the stack just as you wrote them. Thus,
FORK FOO,BAZ,GARP generates
MOV GARP,-(SP)
MOV BAZ,-(SP)
MOV FOO,-(SP)
EMT 1
This sequence causes the process described by the block pointed
to by the contents of FOO to start up at the location contained
in BAZ with the priority that GARP contains. To start process
FOO at location BAZ with priority 1, you should say
FORK #FOO,#BAZ,#1.
In the case of event identifiers, the thing to put on the stack
is the value that EVMAK returned (not the address of a cell that
cntains that value.
All of these operations pop their arguments off your stack and
push any results. They return with the C bit off for success
and on for failure (few of them can fail).
The following two macros are for my convenience.
⊗
.MACRO EMTDEF NAME,PROG,ARGS,PARGS
DEFMAC NAME,↑\ARGS\,↑\PARGS\,\NXTEMT
NXTEMT==NXTEMT+1
.ENDM
.MACRO DEFMAC NAME,ARGS,PARGS,EMTNUM
.MACRO NAME ARGS
PARGS EMTNUM
.ENDM
.ENDM
104000 NXTEMT==104000
COMMENT⊗ DISMIS (no arguments): This operation kills the
process that uses it. The only thing left is the
descriptor, which you may recycle. By the way,
if every process has DISMISed, the Kernel will
get you into DDT. This operation, by its very
nature, can not return.
PALX 222 04/21/75 21:12:45 PAGE 7
KDEF PAL[11,SYS] PAGE 3.1
⊗
EMTDEF DISMIS,.DISMI
DEFMAC DISMIS,↑\\,↑\\,\NXTEMT
.MACRO DISMIS
104000
.ENDM
104001 NXTEMT==NXTEMT+1
COMMENT⊗ FORK PROCES,LOC,PRI creates a process and starts
it up right now. PROCES is the address of a descriptor
block, LOC is the location where it is to start, and
PRI is its nominal priority. A word about priorities:
FORK and SCHEDU set the nominal priority by putting
twice PRI into word 1 of the descriptor block. This
quantity determines which run queue the process will
be on whenever it is activated. You may change this
value at any time, and it will take effect the next
time the process activates (e.g., after sleeping).
The "nominal priority" is a lower limit on the actual
running priority which you may set with a SETPRI.
Note that if your nominal priority is 1 and you set
the running priority to 4 and sleep, you will be put
on the priority 1 queue when you wake up and will run
at level 4 when your turn comes up.
⊗
EMTDEF FORK,.FORK,↑\PDB,LOC,PRI\,↑\ MOV PRI,-(SP)
MOV LOC,-(SP)
MOV PDB,-(SP)
\
DEFMAC FORK,↑\PDB,LOC,PRI\,↑\ MOV PRI,-(SP)
MOV LOC,-(SP)
MOV PDB,-(SP)
\,\NXTEMT
.MACRO FORK PDB,LOC,PRI
MOV PRI,-(SP)
MOV LOC,-(SP)
MOV PDB,-(SP)
104001
.ENDM
104002 NXTEMT==NXTEMT+1
COMMENT⊗ EVMAK (no args) creates an event and returns its identifier
on your stack. Thereafter, use the returned value to refer
to that event.
⊗
EMTDEF EVMAK,.EVMAK
DEFMAC EVMAK,↑\\,↑\\,\NXTEMT
.MACRO EVMAK
104002
PALX 222 04/21/75 21:12:45 PAGE 8
KDEF PAL[11,SYS] PAGE 3.2
.ENDM
104003 NXTEMT==NXTEMT+1
COMMENT⊗ EVKIL EVENT destroys the specified event. If any
process is waiting for that event, it will be awakened
with the failure return.
⊗
EMTDEF EVKIL,.EVKIL,E,↑\ MOV E,-(SP)
\
DEFMAC EVKIL,↑\E\,↑\ MOV E,-(SP)
\,\NXTEMT
.MACRO EVKIL E
MOV E,-(SP)
104003
.ENDM
104004 NXTEMT==NXTEMT+1
COMMENT⊗ EVWAIT EVENT puts the process on the wait list for the
specified event. If the event has already happened,
EVWAIT returns immediately. C=0 means it happened, C=1
means the event has been destroyed.
⊗
EMTDEF EVWAIT,.EVWAI,E,↑\ MOV E,-(SP)
\
DEFMAC EVWAIT,↑\E\,↑\ MOV E,-(SP)
\,\NXTEMT
.MACRO EVWAIT E
MOV E,-(SP)
104004
.ENDM
104005 NXTEMT==NXTEMT+1
COMMENT⊗ EVSIG EVENT causes the specified event to happen once.
If any processes are waiting for it, the first one one
the queue will wake up (strictly first come, first served
with no account of priorities).
⊗
EMTDEF EVSIG,.EVSIG,E,↑\ MOV E,-(SP)
\
DEFMAC EVSIG,↑\E\,↑\ MOV E,-(SP)
\,\NXTEMT
.MACRO EVSIG E
MOV E,-(SP)
104005
.ENDM
104006 NXTEMT==NXTEMT+1
COMMENT⊗ SLEEP MSEC puts you to sleep for the specified number
of milliseconds, up to 65535. SLEEP #0, for the time
being, is a no-no.
⊗
EMTDEF SLEEP,.SLEEP,MSEC,↑\ MOV MSEC,-(SP)
PALX 222 04/21/75 21:12:45 PAGE 9
KDEF PAL[11,SYS] PAGE 3.3
\
DEFMAC SLEEP,↑\MSEC\,↑\ MOV MSEC,-(SP)
\,\NXTEMT
.MACRO SLEEP MSEC
MOV MSEC,-(SP)
104006
.ENDM
104007 NXTEMT==NXTEMT+1
COMMENT⊗ SCHEDU PROCES,LOC,PRI,MSEC is roughly the same as doing
a FORK PROCES,LOC,PRI and having the new process immediately
do a SLEEP MSEC. The difference comes when PRI is less
than or equal to the running priority of the process that
executed the SCHEDU. In that case, the FORK-SLEEP sequence
might schedule the target fork somewhat later than the
SCHEDU does, since the new fork actually has to start up
before it re-schedules itself.
⊗
EMTDEF SCHEDU,.SCHED,↑\JOB,ADR,PRI,MSEC\,↑\ MOV MSEC,-(SP)
MOV PRI,-(SP)
MOV ADR,-(SP)
MOV JOB,-(SP)
\
DEFMAC SCHEDU,↑\JOB,ADR,PRI,MSEC\,↑\ MOV MSEC,-(SP)
MOV PRI,-(SP)
MOV ADR,-(SP)
MOV JOB,-(SP)
\,\NXTEMT
.MACRO SCHEDU JOB,ADR,PRI,MSEC
MOV MSEC,-(SP)
MOV PRI,-(SP)
MOV ADR,-(SP)
MOV JOB,-(SP)
104007
.ENDM
104010 NXTEMT==NXTEMT+1
COMMENT⊗ SETPRI NEW sets your running priority to your nominal
priority or NEW, whichever is higher, and returns your
previous running priority on the stack. If NEW was
lower than the nominal priority, the C bit will be on.
⊗
EMTDEF SETPRI,.SETPR,NEW,↑\ MOV NEW,-(SP)
\
DEFMAC SETPRI,↑\NEW\,↑\ MOV NEW,-(SP)
\,\NXTEMT
.MACRO SETPRI NEW
MOV NEW,-(SP)
104010
.ENDM
104011 NXTEMT==NXTEMT+1
PALX 222 04/21/75 21:12:45 PAGE 10
KDEF PAL[11,SYS] PAGE 4
COMMENT⊗ Loading and running your program with this system
The Kernel arbitrarily takes up the first 4K words of memory (it's
much smaller than that right now, but we'll leave room for expansion).
The last three words of this 4K block contain vital information about
your main program, which you must set up (you can do it at compile time).
⊗
020000 USRORG==20000
017772 JOBDAT=USRORG-6 ;Location of the descriptor block for your
;main program.
017774 JOBSA=USRORG-4 ;Starting address of your main program.
017776 JOBPDL=USRORG-2 ;Initial value of your stack pointer.
020000 .=USRORG
COMMENT⊗ To get on the air, you can use the following 11TTY
commands:
*αXUSEDDT
*LOAD BIN FILE - <your program>
*OVERLAY BIN FILE - K[11,SYS]
Then you can start in DDT if you wish, but before starting your
program you should start the Kernel at location 1000. The Kernel
will initialize itself, set up your stack from JOBPDL, start up the
null job (a vital part of any system!), and finally FORK to the
process described by JOBDAT and JOBSA, at priority 0. Any breakpoints
you set while in DDT will have the right effect, and you can one-step
system calls. The only thing that will cause problems is having
breakpoints set in any interrupt-driven routine (including one that
is sleeping) when you are one-stepping another process. I plan to
fix that problem soon.
⊗
PALX 222 04/21/75 21:12:45 PAGE 11
HALHED PAL[HAL,HE] PAGE 2.1
.INSRT HALHED.PAL[HAL,HE]
PALX 222 04/21/75 21:12:45 PAGE 12
HALHED PAL[HAL,HE] PAGE 1
COMMENT ⊗ VALID 00005 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 .SBTTL ASSEMBLY FLAGS
C00005 00003 routine calling and defining macros.
C00008 00004 macros for handling tables & blocks
C00012 00005 Graph structure definitions
C00014 ENDMK
C⊗;
PALX 222 04/21/75 21:12:45 PAGE 13
HALHED PAL[HAL,HE] PAGE 2 ASSEMBLY FLAGS
.SBTTL ASSEMBLY FLAGS
;This macro gives the switch SW a default value VAL
.MACRO STSW SW,VAL
.IFNDF SW
SW == VAL ;if do not have a value already, give it one
.ENDC
.ENDM
STSW FLOAT,1 ;0 => no floating point capacity
.IFNDF FLOAT
FLOAT == 1 ;if do not have a value already, give it one
.ENDC
.SBTTL DEFS -- standard definitions for HAL runtime routines
; PROGRAM DEFINITIONS
000004 ERRTRP==4 ;time out and error trap
000010 ILGINS==10 ;illegal instruction
000104 CLKTRP==104 ;clock trap
050000 RUG=50000 ;Restart of RUG
177776 PS=177776 ;processor status word
177560 KBIS=177560 ;keyboard input status
177562 KBIR=177562 ;keyboard input register
177564 KBOS=177564 ;keyboard output status
177566 KBOR=177566 ;keyboard output register
172544 CLKCNT=172544 ;clock counter
172542 CLKSET=172542 ;clock set register
172540 CLKS=172540 ;clock status
000500 STRT11=500 ;starting address of program
000150 IBUF==150 ;start of input buffer from 11
000160 OBUF==160 ;start of output buffer to 11
077776 HCOR=77776 ;highest useable word in core
;REGISTER DEFINITIONS
000007 PC=%7 ;program counter
000006 SP=%6 ;stack pointer
000005 RF==%5 ;Display pointer
000005 R5=%5
000004 R4=%4 ;Saved across procedure calls
000003 R3=%3 ;Saved across procedure calls
000002 R2=%2 ;Saved across procedure calls
000001 R1=%1 ;temp
000000 R0=%0 ;temp
000005 AC5==%5 ;Temp Floating point register
PALX 222 04/21/75 21:12:45 PAGE 14
HALHED PAL[HAL,HE] PAGE 2.1 DEFS -- standard definitions for HAL runtime routines
000004 AC4==%4 ; " " " "
000003 AC3==%3 ; " " " "
000002 AC2==%2 ; " " " "
000001 AC1==%1 ; " " " "
000000 AC0==%0 ; " " " "
;MARK DEFINITIONS
006400 MARK0 == 6400 ;MARK 0
006401 MARK1 == 6401 ;MARK 1
006402 MARK2 == 6402 ;ETC.
006403 MARK3 == 6403
006404 MARK4 == 6404
006405 MARK5 == 6405
;Absolute address initialization
020000 TEMP == . ;Save location counter for a bit.
000244 . = 244 ;Floating exception
000244 000246 .WORD 246
000246 000002 RTI ;No action taken
020000 . = TEMP ;Restore location counter
PALX 222 04/21/75 21:12:45 PAGE 15
HALHED PAL[HAL,HE] PAGE 3 DEFS -- standard definitions for HAL runtime routines
;routine calling and defining macros.
;Coded by RHT 9/74.
;This should be used at the start of routines which reference
; parameters off the RF stack. It gives the parameters
; symbolic names for clarity of coding.
;For example,
;
; ROUTINE FOO,<A,B>
;
;Goes to
;
; A==4
; B==2
;FOO:
.MACRO ROUTINE ID,ARGS
.IFNB ARGS
NNNN==0
.IRP II,<ARGS> ;Raise NNNN to twice the number of args.
NNNN==NNNN+2
.ENDM
.IRP II,<ARGS> ;Assign each arg NNNN and decrease same.
.IFDF II
.IF1
.ERROR Multiple definition for II
.ENDC
.IFF
II == NNNN
NNNN == NNNN-2
.ENDC
.ENDM
.ENDC
ID:
.ENDM
;This is useful in calling rountines which reference parameters off
; the RF stack. It sets up the stack properly, but does not
; save R0 or R1.
.MACRO CALL ID,ARGS
MOV RF,-(SP) ;Save RF
NNNN == 6400 ;This is a MARK 0 instruction
.IFNB ARGS
.IRP II,<ARGS>
MOV II,-(SP);Push an argument
NNNN == NNNN+1 ;Make NNNN the next MARK instruction.
.ENDM
.ENDC
PALX 222 04/21/75 21:12:45 PAGE 16
HALHED PAL[HAL,HE] PAGE 3.1 DEFS -- standard definitions for HAL runtime routines
MOV #NNNN,-(SP) ;Push the mark instruction.
MOV SP,RF ;Set up the display in RF.
JSR PC,ID ;Call the routine
.ENDM
;This macro is a temporary(ha,ha) method of defining floating point
;constants. LABIL is the constant name and MSB and LSB it's two
;16bit octal parts.
.MACRO FP LABIL,MSB,LSB
.MACRO LABIL
.WORD MSB,LSB
.ENDM
.ENDM
;Macros to tell value of variable during assembly
.MACRO TELL VAR
TELL2 VAR,\VAR
.ENDM
.MACRO TELL2 S,V
.PRINT /S = /
.PRINT /V
/
.ENDM
PALX 222 04/21/75 21:12:45 PAGE 17
HALHED PAL[HAL,HE] PAGE 4 DEFS -- standard definitions for HAL runtime routines
;macros for handling tables & blocks
.MACRO XX SYM ;Just gives SYM the next number.
.IFDF SYM
.IF1
.ERROR You are using SYM in two ways!!!
.ENDC
.ENDC
SYM == II
II == II+2
.ENDM
.MACRO PUTLOC ADR,VAL
II==.
.= ADR
VAL
.=II
.ENDM
.MACRO TT INX,VAL
.=II+INX
VAL
.ENDM
;SMALL BLOCK DESCRIPTOR FORMAT
000000 II == 0
XX IDFLAG ;ACTUALLY A BYTE -- GETS PUT IN ID PART OF TAG WORD
.IFDF IDFLAG
.IF1
.ERROR You are using IDFLAG in two ways!!!
.ENDC
.ENDC
000000 IDFLAG == II
000002 II == II+2
XX MAPRTN ;ROUTINE TO BE CALLED ON MARK
.IFDF MAPRTN
.IF1
.ERROR You are using MAPRTN in two ways!!!
.ENDC
.ENDC
000002 MAPRTN == II
000004 II == II+2
XX SIZE ;How many words for a value cell in this type block.
.IFDF SIZE
.IF1
.ERROR You are using SIZE in two ways!!!
.ENDC
.ENDC
PALX 222 04/21/75 21:12:45 PAGE 18
HALHED PAL[HAL,HE] PAGE 4.1 DEFS -- standard definitions for HAL runtime routines
000004 SIZE == II
000006 II == II+2
XX NPERB ;NUMBER OF BLOCKS PER BUFFER
.IFDF NPERB
.IF1
.ERROR You are using NPERB in two ways!!!
.ENDC
.ENDC
000006 NPERB == II
000010 II == II+2
XX GCFG ;SET IF THIS IS NOT A COLLECTABLE AREA
.IFDF GCFG
.IF1
.ERROR You are using GCFG in two ways!!!
.ENDC
.ENDC
000010 GCFG == II
000012 II == II+2
XX NMIN ;MIN NUMBER OF FREE BLOCKS TO BE RETURNED BY GC
.IFDF NMIN
.IF1
.ERROR You are using NMIN in two ways!!!
.ENDC
.ENDC
000012 NMIN == II
000014 II == II+2
XX NPCT ;MIN % OF FREE BLOCKS TO BE RETURNED BY GC
.IFDF NPCT
.IF1
.ERROR You are using NPCT in two ways!!!
.ENDC
.ENDC
000014 NPCT == II
000016 II == II+2
XX NXTSID ;NEXT BLOCK ON ID CHAIN
.IFDF NXTSID
.IF1
.ERROR You are using NXTSID in two ways!!!
.ENDC
.ENDC
000016 NXTSID == II
000020 II == II+2
XX FFREE ;FREE LIST
.IFDF FFREE
.IF1
.ERROR You are using FFREE in two ways!!!
.ENDC
.ENDC
000020 FFREE == II
PALX 222 04/21/75 21:12:45 PAGE 19
HALHED PAL[HAL,HE] PAGE 4.2 DEFS -- standard definitions for HAL runtime routines
000022 II == II+2
XX FSTBUF ;OLDEST BUFFER
.IFDF FSTBUF
.IF1
.ERROR You are using FSTBUF in two ways!!!
.ENDC
.ENDC
000022 FSTBUF == II
000024 II == II+2
XX LSTBUF ;NEWEST BUFFER
.IFDF LSTBUF
.IF1
.ERROR You are using LSTBUF in two ways!!!
.ENDC
.ENDC
000024 LSTBUF == II
000026 II == II+2
XX NALLOC ;NUMBER ALLOCATED
.IFDF NALLOC
.IF1
.ERROR You are using NALLOC in two ways!!!
.ENDC
.ENDC
000026 NALLOC == II
000030 II == II+2
XX NFREE ;NUMBER FREE
.IFDF NFREE
.IF1
.ERROR You are using NFREE in two ways!!!
.ENDC
.ENDC
000030 NFREE == II
000032 II == II+2
000032 SPCHDR == II
;; EACH BUFFER
000000 II == 0
XX NXTBUF ;NEXT BUFFER
.IFDF NXTBUF
.IF1
.ERROR You are using NXTBUF in two ways!!!
.ENDC
.ENDC
000000 NXTBUF == II
000002 II == II+2
XX PRVBUF ;PREVIOUS BUFFER
.IFDF PRVBUF
.IF1
.ERROR You are using PRVBUF in two ways!!!
PALX 222 04/21/75 21:12:45 PAGE 20
HALHED PAL[HAL,HE] PAGE 4.3 DEFS -- standard definitions for HAL runtime routines
.ENDC
.ENDC
000002 PRVBUF == II
000004 II == II+2
XX LSTBLK ;ADDRESS OF LAST BLOCK IN THIS BUFFER
.IFDF LSTBLK
.IF1
.ERROR You are using LSTBLK in two ways!!!
.ENDC
.ENDC
000004 LSTBLK == II
000006 II == II+2
XX FSTBLK ;POINTS AT FIRST LOCN
.IFDF FSTBLK
.IF1
.ERROR You are using FSTBLK in two ways!!!
.ENDC
.ENDC
000006 FSTBLK == II
000010 II == II+2
000010 BUFHDR == II
;; EACH BLOCK
000000 II == 0
177777 TAG == -1 ;≠0 MEANS INUSE (USED IN GC)
177776 TAGID == -2 ;USED TO HOLD AN "ID" FOR THIS RECORD
XX WORD0 ;FIRST DATA WORD
.IFDF WORD0
.IF1
.ERROR You are using WORD0 in two ways!!!
.ENDC
.ENDC
000000 WORD0 == II
000002 II == II+2
;;GC METHODS
000000 II == 0
XX METH ;ROUTINE TO CALL
.IFDF METH
.IF1
.ERROR You are using METH in two ways!!!
.ENDC
.ENDC
000000 METH == II
000002 II == II+2
XX NXTMTH ;NEXT ON CHAIN
.IFDF NXTMTH
.IF1
.ERROR You are using NXTMTH in two ways!!!
PALX 222 04/21/75 21:12:45 PAGE 21
HALHED PAL[HAL,HE] PAGE 4.4 DEFS -- standard definitions for HAL runtime routines
.ENDC
.ENDC
000002 NXTMTH == II
000004 II == II+2
.MACRO MMETH ROUT
ROUT
0
.ENDM
;;SPECIAL SPACES
.IF2
000000 SIDHED == SIDCHN ;SO AUTOMATIC LINKAGE WORKS
.ENDC
000000 SIDCNT == 0;
000000 SIDCHN == 0;
.MACRO DEFSPC ID,MMRT,SZ,NPB,GCF,NMN,NPC
.IFNDF ID
SIDCNT==SIDCNT+1
ID==SIDCNT
.ENDC
II==.
.BLKW SPCHDR/2
TT IDFLAG,ID
TT MAPRTN,MMRT
TT SIZE,SZ
TT NPERB,NPB
TT GCFG,GCF
TT NMIN,NMN
TT NPCT,NPC
TT NXTSID,SIDCHN
TT FFREE,0
TT FSTBUF,0
TT LSTBUF,0
TT NALLOC,0
TT NFREE,0
.=II+SPCHDR
SIDCHN == II
.IF2
.IFGE MAXIDF-ID
II==.
.=SIDTBL+<ID*2>
SIDCHN
.=II
.ENDC
.ENDC
.ENDM
PALX 222 04/21/75 21:12:45 PAGE 22
HALHED PAL[HAL,HE] PAGE 4.5 DEFS -- standard definitions for HAL runtime routines
000030 MAXIDF == 30 ;MAX INDEX INTO SIDTBL
PALX 222 04/21/75 21:12:45 PAGE 23
HALHED PAL[HAL,HE] PAGE 5 DEFS -- standard definitions for HAL runtime routines
;Graph structure definitions
;RHT 9/74
;CELL LINKS
000000 II==0
XX DATUM
.IFDF DATUM
.IF1
.ERROR You are using DATUM in two ways!!!
.ENDC
.ENDC
000000 DATUM == II
000002 II == II+2
XX LINKF
.IFDF LINKF
.IF1
.ERROR You are using LINKF in two ways!!!
.ENDC
.ENDC
000002 LINKF == II
000004 II == II+2
XX LINKB
.IFDF LINKB
.IF1
.ERROR You are using LINKB in two ways!!!
.ENDC
.ENDC
000004 LINKB == II
000006 II == II+2
;GRAPH NODES
000000 II==0
XX NXTGN ;CHAIN OF ALL GNODES IN THE WORLD
.IFDF NXTGN
.IF1
.ERROR You are using NXTGN in two ways!!!
.ENDC
.ENDC
000000 NXTGN == II
000002 II == II+2
XX PRVGN
.IFDF PRVGN
.IF1
.ERROR You are using PRVGN in two ways!!!
.ENDC
.ENDC
000002 PRVGN == II
000004 II == II+2
XX INVMRK ;USED AS FLAG
PALX 222 04/21/75 21:12:45 PAGE 24
HALHED PAL[HAL,HE] PAGE 5.1 DEFS -- standard definitions for HAL runtime routines
.IFDF INVMRK
.IF1
.ERROR You are using INVMRK in two ways!!!
.ENDC
.ENDC
000004 INVMRK == II
000006 II == II+2
XX GNVAL ;POINTER AT VALUE
.IFDF GNVAL
.IF1
.ERROR You are using GNVAL in two ways!!!
.ENDC
.ENDC
000006 GNVAL == II
000010 II == II+2
XX GNDEPS ;DEPENDENT GRAPH NODES
.IFDF GNDEPS
.IF1
.ERROR You are using GNDEPS in two ways!!!
.ENDC
.ENDC
000010 GNDEPS == II
000012 II == II+2
XX GNCLCS ;CALCULATOR LIST (DBL LINKED)
.IFDF GNCLCS
.IF1
.ERROR You are using GNCLCS in two ways!!!
.ENDC
.ENDC
000012 GNCLCS == II
000014 II == II+2
XX GNCHGS ;CHANGE LIST
.IFDF GNCHGS
.IF1
.ERROR You are using GNCHGS in two ways!!!
.ENDC
.ENDC
000014 GNCHGS == II
000016 II == II+2
;CALCULATOR CELL
000000 II==0
XX NXTCLC ;LIST LINK
.IFDF NXTCLC
.IF1
.ERROR You are using NXTCLC in two ways!!!
.ENDC
.ENDC
000000 NXTCLC == II
PALX 222 04/21/75 21:12:45 PAGE 25
HALHED PAL[HAL,HE] PAGE 5.2 DEFS -- standard definitions for HAL runtime routines
000002 II == II+2
XX NEEDED ;LIST OF NEEDED NODES
.IFDF NEEDED
.IF1
.ERROR You are using NEEDED in two ways!!!
.ENDC
.ENDC
000002 NEEDED == II
000004 II == II+2
XX FORM ;SOME SORT OF CODE TO EVAL
.IFDF FORM
.IF1
.ERROR You are using FORM in two ways!!!
.ENDC
.ENDC
000004 FORM == II
000006 II == II+2
;CHANGER CELL
000000 II==0
XX NXTCHG
.IFDF NXTCHG
.IF1
.ERROR You are using NXTCHG in two ways!!!
.ENDC
.ENDC
000000 NXTCHG == II
000002 II == II+2
XX CHGCOD
.IFDF CHGCOD
.IF1
.ERROR You are using CHGCOD in two ways!!!
.ENDC
.ENDC
000002 CHGCOD == II
000004 II == II+2
PALX 222 04/21/75 21:12:45 PAGE 26
HALIO PAL[HAL,HE] PAGE 2.1 DEFS -- standard definitions for HAL runtime routines
.INSRT HALIO.PAL[HAL,HE]
PALX 222 04/21/75 21:12:45 PAGE 27
HALIO PAL[HAL,HE] PAGE 1 DEFS -- standard definitions for HAL runtime routines
COMMENT ⊗ VALID 00016 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 .SBTTL TTY output routines
C00006 00003 Useful macros for use of I/O routines
C00009 00004 The following pages contain floating point input-output routines.
C00010 00005 STRING TO FLOATING POINT NUMBER ROUTINE - "RELSCN".
C00013 00006 [CONTINUATION OF "RELSCN"]
C00016 00007 [CONTINUATION OF "RELSCN"]
C00018 00008 ROUTINES TO SET AND RESTORE OUTPUT FORMAT - "FORMAT"&"RSTFOR"
C00020 00009 FLOATING POINT NUMBER TO "F" FORMAT STRING ROUTINE - "CVF"
C00023 00010 FLOATING POINT NUMBER TO "E" FORMAT STRING ROUTINE - "CVE"
C00026 00011 [CONTINUATION OF "CVE"]
C00027 00012 FLOATING POINT NUMBER TO "E" OR "F" FORMAT STRING - "CVG"
C00029 00013 PRINTING ROUTINE USED BY "CVF" & "CVE"
C00032 00014 This is the end of the floating package.
C00033 00015 VT05 INPUT ROUTINE - "INSTR"
C00036 00016 LOCAL STORAGE AREA
C00040 ENDMK
C⊗;
PALX 222 04/21/75 21:12:45 PAGE 28
HALIO PAL[HAL,HE] PAGE 2 TTY output routines
.SBTTL TTY output routines
020000 .EVEN
; Modified 5-Sep-74 by RF. Originally written by KKP.
; Output a string, ending with a zero character. Pointer to start
; of string in R0. Called in "simple" style.
020000 010001 TYPSTR: MOV R0,R1 ;R1 ← LOC[STRING]
020002 112100 MOVB (R1)+,R0 ;R0 ← first byte of string
020004 004767 000056 TSLOOP: JSR PC,TYPCHR ;Type this one character
020010 112100 MOVB (R1)+,R0 ;R0 ← Next byte of string
020012 001374 BNE TSLOOP ;If more to come, repeat.
020014 000207 RTS PC ;Done
; Routines to output numbers. Argument in R0.
; TYPDEC outputs in base 10, and TYPOCT in base 8.
; Both use TYPDIG as a subroutine, putting the digit
; in R0.
; TYPCHR is a general purpose character output routine.
020016 012767 000012 000020 TYPDEC: MOV #12,RADIX ;To output in base 10
020024 000404 BR TYPDIG ;Go type it.
020026 012767 000010 000010 TYPOCT: MOV #8,RADIX ;To output in base 8.
020034 000400 BR TYPDIG ;Go type it.
020036 010001 TYPDIG: MOV R0,R1 ;Need dividend in R1, with R0 clear.
020040 005000 CLR R0 ;Clear upper half of dividend.
020042 071027 DIV (PC)+,R0 ;Divide argument in R0, R1 by radix.
020044 000012 RADIX: 12 ;Starts out in decimal.
020046 001404 BEQ TYPOUT ;If quotient zero, then can print.
020050 010146 MOV R1,-(SP) ;Else stack quotient
020052 004767 177760 JSR PC,TYPDIG ;Recursive call.
020056 012601 MOV (SP)+,R1 ;Unstack last quotient
020060 062701 000060 TYPOUT: ADD #'0,R1 ;Form TTY code for digit
020064 010100 MOV R1,R0 ;Need argument for TYPCHR in R0.
020066 105767 157472 TYPCHR: TSTB KBOS ;Is TTY available?
020072 100375 BPL TYPCHR ;No. Busy wait for it.
020074 110067 157466 MOVB R0,KBOR ;Yes. Output a byte to it.
020100 022700 000012 CMP #12,R0 ;Was it a line feed?
020104 001007 BNE TYPRET ;If not that code, then done.
020106 005000 CLR R0 ;Otherwise, output 3 nulls.
020110 004767 177752 JSR PC,TYPCHR ;
020114 004767 177746 JSR PC,TYPCHR ;
020120 004767 177742 JSR PC,TYPCHR ;
020124 000207 TYPRET: RTS PC ;Return.
PALX 222 04/21/75 21:12:45 PAGE 29
HALIO PAL[HAL,HE] PAGE 3 TTY output routines
; Useful macros for use of I/O routines
.MACRO OUTSTR B ;Type string starting at B.
MOV R0,-(SP) ;Save R0. Who knows what was happening in it?
MOV R1,-(SP) ;Save R1.
MOV #B,R0 ;Load up the string to be output
JSR PC,TYPSTR ;Call the string output utility routine.
MOV (SP)+,R1 ;Restore R1.
MOV (SP)+,R0 ;Restore R0.
.ENDM
.MACRO NUMOUT ;Type out the number in AC0 with CVG using OUTBUF
MOV R0,-(SP) ;Save the registers
MOV R1,-(SP)
STF AC0,-(SP)
STF AC1,-(SP)
MOV #OUTBUF,R0 ;Use OUTBUF to construct the string
JSR PC,CVG ;Convert floating point number to asc
LDF (SP)+,AC1 ;Restore the floating point registers
LDF (SP)+,AC0
MOV #OUTBUF,R0 ;Set pointer for i/o routine
JSR PC,TYPSTR ;Type out the number
MOV (SP)+,R1 ;Restore the registers
MOV (SP)+,R0
.ENDM
.MACRO ASCIE STR
.ASCIZ STR
.EVEN
.ENDM
.MACRO CRLF
OUTSTR CRLFX ;Carriage return, line feed.
.ENDM
020126 015
020127 012 CRLFX: .ASCIZ /
020130 000
/
RUGMES: ASCIE </π
--ONLY DDT CAN HELP YOU NOW!
π/>
020131 007
020132 015
020133 012 .ASCIZ /π
020134 055
020135 055
020136 117
PALX 222 04/21/75 21:12:45 PAGE 30
HALIO PAL[HAL,HE] PAGE 3.1 TTY output routines
020137 116
020140 114
020141 131
020142 040
020143 104
020144 104
020145 124
020146 040
020147 103
020150 101
020151 116
020152 040
020153 110
020154 105
020155 114
020156 120
020157 040
020160 131
020161 117
020162 125
020163 040
020164 116
020165 117
020166 127
020167 041
020170 015
020171 012 --ONLY DDT CAN HELP YOU NOW!
020172 007
020173 000
π/
020174 .EVEN
.MACRO HALERR MES ;Bad error. Type message, call debugger.
MOV R0,-(SP) ;Save R0.
MOV R1,-(SP) ;Save R1.
MOV #CRLFX,R0 ;Move to new line
JSR PC,TYPSTR ;
MOV #MES,R0 ;Type out message
JSR PC,TYPSTR ;
MOV #RUGMES,R0 ;Type out RUGMES
JSR PC,TYPSTR ;
MOV (SP)+,R1 ;Restore R1.
MOV (SP)+,R0 ;Restore R2.
BPT ;Breakpoint to DDT.
.ENDM
PALX 222 04/21/75 21:12:45 PAGE 31
HALIO PAL[HAL,HE] PAGE 4 TTY output routines
;The following pages contain floating point input-output routines.
;Coded by BES 9/74.
000001 .IFNZ FLOAT
PALX 222 04/21/75 21:12:45 PAGE 32
HALIO PAL[HAL,HE] PAGE 5 TTY output routines
;STRING TO FLOATING POINT NUMBER ROUTINE - "RELSCN".
;THE FLOATING POINT NUMBER MUST BE OF THE FORM SIII.DDDESXX WHERE S IS
;THE SIGN OF THE NUMBER, III IS THE INTEGER FIELD, DDD IS THE DECIMAL
;FIELD, AND SXX IS THE EXPONENT AND ITS SIGN. THE LENGTH OF EACH
;FIELD IS VARIABLE BUT ONLY THE FIRST 8 DIGITS ARE USED IN COMPUTING
;THE F.P. NUMBER. EMPTY FIELDS ARE PERMITTED AND ALL LEADING SPACES
;AND ZEROS ARE IGNORED. THE LOCATION OF THE FIRST BYTE OF THE STRING
;MUST BE LOADED INTO R0 BEFORE CALLING "RELSCN". AFTER EXECUTION,
;THIS ROUTINE LEAVES THE F.P. NUMBER IN REGISTER AC0 AND R0 POINTS TO
;THE BYTE FOLLOWING THE LAST DIGIT. R1 CONTAINS AN ERROR CODE. IF NO
;NUMBER WAS FOUND, R1 IS -1 ELSE R1 IS 0. "RELSCN" IS CALLED IN THE
;"SIMPLE STYLE".
;REGISTERS USED:
;
; R0,R1,AC0 PASS ARGUMENTS
; NO OTHER REGISTERS AFFECTED
.STITLE FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
;"DIGIT" CHECKS FOR ASC DIGIT AND CONVERTS TO INTEGER IF IT IS
.MACRO DIGIT NOTDIG
CMP R4,#60 ;COMPARE TO ASC ZERO
BLT NOTDIG ;SKIP IF OUT OF RANGE
CMP R4,#71 ;COMPARE TO ASC 9
BGT NOTDIG ;SKIP IF OUT OF RANGE
BIC #60,R4 ;MASK OUT ASC BASE
.ENDM
;"CKSIGN" CHECKS FOR A - OR + CHARACTER AND SETS SIGN APPROPRIATELY
.MACRO CKSIGN ISSIGN,NTSIGN,SIGN
CMP #53,R4 ;IGNOR "+" CHARACTER
BEQ ISSIGN
CMP #55,R4 ;CHECK IF ITS A "-" CHAR.
BNE NTSIGN ;EXIT IF ITS NOT
INC SIGN ;ELSE SET SIGN NON-ZERO
JMP ISSIGN
.ENDM
;START OF "RELSCN"
020174 .EVEN
020174 010246 RELSCN: MOV R2,-(SP) ;SAVE REGISTER
020176 010346 MOV R3,-(SP) ;SAVE REGISTER
020200 010446 MOV R4,-(SP)
020202 005002 CLR R2 ;RESET DIGIT COUNT
PALX 222 04/21/75 21:12:45 PAGE 33
HALIO PAL[HAL,HE] PAGE 5.1 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
020204 012703 000001 MOV #1,R3 ;SET DECIMAL POINT FLAG
020210 012701 177777 MOV #-1,R1 ;INDICATE NO DIGITS ENCOUNTERED
020214 170167 001474 LDFPS STAT ;SET THE FFP STATUS WORD
020220 170400 CLRF AC0 ;CLEAR THE NUMBER ACCUM
020222 005067 001470 CLR MSIGN ;ASSUME MANTISSA POSITIVE
PALX 222 04/21/75 21:12:45 PAGE 34
HALIO PAL[HAL,HE] PAGE 6 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
[CONTINUATION OF "RELSCN"]
;PICK UP A CHARACTER AND CHECK FOR SIGN
020226 112004 PICK: MOVB (R0)+,R4 ;PICK UP A CHARACTER
020230 005701 TST R1 ;CHECK IF DIGIT ENCOUNTERED
020232 001412 BEQ CHKDG ;SKIP IF TRUE
CKSIGN PICK,CHKDG,MSIGN ;CHECK FOR + OR - SIGN
020234 022704 000053 CMP #53,R4 ;IGNOR "+" CHARACTER
020240 001772 BEQ PICK
020242 022704 000055 CMP #55,R4 ;CHECK IF ITS A "-" CHAR.
020246 001004 BNE CHKDG ;EXIT IF ITS NOT
020250 005267 001442 INC MSIGN ;ELSE SET MSIGN NON-ZERO
020254 000167 177746 JMP PICK
;CHECK IF CHARARCTER IS A DIGIT
CHKDG: DIGIT CHKDP ;SKIP TO CHKDP IF NOT A DIGIT
020260 020427 000060 CMP R4,#60 ;COMPARE TO ASC ZERO
020264 002420 BLT CHKDP ;SKIP IF OUT OF RANGE
020266 020427 000071 CMP R4,#71 ;COMPARE TO ASC 9
020272 003015 BGT CHKDP ;SKIP IF OUT OF RANGE
020274 042704 000060 BIC #60,R4 ;MASK OUT ASC BASE
020300 171067 001742 MULF TEN,AC0 ;MULT DIGIT SUM BY 10
020304 072427 000002 ASH #2,R4 ;MULTIPLY INDEX BY 4
020310 172064 021742 ADDF DGLST(R4),AC0 ;ADD THE F.P./10 TO ACCUM
020314 005001 CLR R1 ;INDICATE DIGIT ENCOUNTERED
020316 162702 000004 SUB #4,R2 ;DECREMENT DIGIT COUNT
020322 000167 177700 JMP PICK ;GO GET ANOTHER CHARACTER
;CHECK IF THE CHARACTER IS A DECIMAL POINT
020326 022704 000056 CHKDP: CMP #56,R4 ;COMPARE CHARACTER TO DECIMAL PT
020332 001007 BNE RNORM ;SKIP IF NOT D.P.
020334 005703 TST R3 ;CHECK IF DECIMAL POINT ALREADY SET
020336 001405 BEQ RNORM ;IF RESET THIS MUST BE A THE END OF THE MANT.
020340 005002 CLR R2 ;START COUNTING FRACTIONAL DIGITS
020342 005003 CLR R3 ;INDICATE D.P. SET
020344 005001 CLR R1 ;INDICATE DIGIT ENCOUNTERED
020346 000167 177654 JMP PICK ;GO GET ANOTHER CHARACTER
;CORRECT NUMBER FOR POWER OF TEN IF DIGITS FOUND
020352 005701 RNORM: TST R1 ;CHECK IF DIGITS FOUND
020354 001004 BNE CHKEX ;SKIP IF NONE
020356 005703 TST R3 ;CHECK IF DECIMAL POINT SET
020360 001002 BNE CHKEX ;DONT NORMALIZE IF NO D.P.
020362 171062 022242 MULF TENLST(R2),AC0 ;CORRECT DECIMAL POINT
PALX 222 04/21/75 21:12:45 PAGE 35
HALIO PAL[HAL,HE] PAGE 6.1 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
;CHECK IF E SIGN ENCOUNTERED
020366 022704 000105 CHKEX: CMP #105,R4 ;COMPARE TO E CHARACTER
020372 001053 BNE CHKDN ;SKIP IF NOT E
020374 005701 TST R1 ;CHECK IF NO DIGITS BEFORE E
020376 001403 BEQ EXCN
020400 172467 001636 LDF TENLST,AC0 ;SET AC0=1 IF EXPONENT BUT NO DIGITS
020404 005001 CLR R1 ;INDICATE DIGITS ENCOUNTERED
020406 005067 001306 EXCN: CLR ESIGN ;ASSUME EXPONENT POSITIVE
020412 005003 CLR R3 ;CLEAR EXPONENT ACCUMULATOR
PALX 222 04/21/75 21:12:45 PAGE 36
HALIO PAL[HAL,HE] PAGE 7 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
[CONTINUATION OF "RELSCN"]
020414 112004 MOVB (R0)+,R4 ;GET NEXT CHARACTER
CKSIGN PIC2,DIG2,ESIGN ;CHECK FOR SIGN CHARACTER
020416 022704 000053 CMP #53,R4 ;IGNOR "+" CHARACTER
020422 001407 BEQ PIC2
020424 022704 000055 CMP #55,R4 ;CHECK IF ITS A "-" CHAR.
020430 001005 BNE DIG2 ;EXIT IF ITS NOT
020432 005267 001262 INC ESIGN ;ELSE SET ESIGN NON-ZERO
020436 000167 000000 JMP PIC2
020442 112004 PIC2: MOVB (R0)+,R4 ;SIGN INCOUNTERED, GET NEXT CHAR.
DIG2: DIGIT NORM ;EXTRACT DIGIT
020444 020427 000060 CMP R4,#60 ;COMPARE TO ASC ZERO
020450 002412 BLT NORM ;SKIP IF OUT OF RANGE
020452 020427 000071 CMP R4,#71 ;COMPARE TO ASC 9
020456 003007 BGT NORM ;SKIP IF OUT OF RANGE
020460 042704 000060 BIC #60,R4 ;MASK OUT ASC BASE
020464 070327 000012 MUL #10.,R3 ;MULT EXPON REG BY 10.
020470 060403 ADD R4,R3 ;ADD DIGIT TO EXPONENT REG
020472 000167 177744 JMP PIC2 ;GO GET ANOTHER CHARACTER
020476 005767 001216 NORM: TST ESIGN ;CHECK SIGN OF EXPONENT
020502 001401 BEQ .+4
020504 005403 NEG R3 ;COMPLEMENT EXPONENT IF - SIGN
020506 072327 000002 ASH #2,R3 ;MULT. INDEX BY 4 FOR F.P. NUMBERS
020512 171063 022242 MULF TENLST(R3),AC0 ;ADJUST EXPONENT OF NUMBER
020516 000167 000010 JMP CDONE ;EXIT ROUTINE
;CHECK IF END OF NUMBER
020522 005704 CHKDN: TST R4 ;COMPARE CHARACTER TO A NULL CHARACTER
020524 001402 BEQ CDONE ;EXIT IF IT IS, THIS IS THE END OF THE STR
020526 005701 TST R1 ;TEST IF ANY DIGITS YET
020530 002636 BLT PICK ;IF NONE, KEEP SCANNING
;NO MORE DIGITS - APPLY CORRECT SIGN TO NUMBER
020532 012604 CDONE: MOV (SP)+,R4 ;RESTORE REGISTERS
020534 012603 MOV (SP)+,R3
020536 012602 MOV (SP)+,R2
020540 005300 DEC R0 ;POINT TO BREAK CHARACTER
020542 005767 001150 TST MSIGN ;TEST SIGN OF MANTISSA
020546 001401 BEQ .+4
020550 170700 NEGF AC0 ;COMPLEMENT NUMBER IF SIGN NEGATIVE
020552 000207 RTS PC ;RETURN
PALX 222 04/21/75 21:12:45 PAGE 37
HALIO PAL[HAL,HE] PAGE 8 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
;ROUTINES TO SET AND RESTORE OUTPUT FORMAT - "FORMAT"&"RSTFOR"
;THE TOTAL NUMBER OF CHARACTERS TO BE WRITTEN (WIDTH) SHOULD BE
;LOADED INTO R0 AND THE NUMBER OF DECIMAL DIGITS (DIGITS) SHOULD
;BE LOADED INTO R1 BEFORE CALLING THIS ROUTINE. IN ALL CASES,
;WIDTH SHOULD BE GREATER THAN OR EQUAL TO DIGIT+2. "FORMAT" IS
;CALLED BY THE "SIMPLE METHOD".
;REGISTERS USED:
;
; R0,R1 PASS ARGUMENTS
; NO OTHER REGISTERS AFFECTED
020554 016767 001150 001152 FORMAT: MOV WIDTH,OLDW ;SAVE THE OLD WIDTH
020562 016767 001144 001146 MOV DIG,OLDD ; AND DIG
020570 162700 000002 SUB #2,R0 ;SUBTRACT SPACES FOR SIGN AND . FROM WIDTH
020574 010067 001130 MOV R0,WIDTH ;SAVE WIDTH OF I/O STRING - 2
020600 010167 001126 MOV R1,DIG ;SAVE THE NUMBER OF DECI. DIGITS
020604 020001 CMP R0,R1 ;CHECK TO SEE THAT WIDTH.GE.DIGIT+2
020606 002012 BGE NFER ;SKIP IF SPACE ALLOWED, ELSE CORRECT
OUTSTR FERM ;TYPE OUT ERROR MESSAGE
020610 010046 MOV R0,-(SP) ;Save R0. Who knows what was happening in it?
020612 010146 MOV R1,-(SP) ;Save R1.
020614 012700 020636 MOV #FERM,R0 ;Load up the string to be output
020620 004767 177154 JSR PC,TYPSTR ;Call the string output utility routine.
020624 012601 MOV (SP)+,R1 ;Restore R1.
020626 012600 MOV (SP)+,R0 ;Restore R0.
020630 010167 001074 MOV R1,WIDTH ;SET WIDTH=DIG+2
020634 000207 NFER: RTS PC ;RETURN
020636 015
020637 012 FERM: .ASCIZ /
020640 106
020641 117
020642 122
020643 115
020644 101
020645 124
020646 124
020647 111
020650 116
020651 107
020652 040
020653 105
020654 122
020655 122
020656 117
020657 122
020660 015
PALX 222 04/21/75 21:12:45 PAGE 38
HALIO PAL[HAL,HE] PAGE 8.1 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
020661 012 FORMATTING ERROR
020662 000
/
020664 .EVEN
;ROUTINE TO RESTORE LAST FORMAT - "RSTFOR"
;THE PREVIOUS FORMAT BECOMES THE CURRENT FORMAT. THE CURRENT
;FORMAT IS LOST FOREVER. "RSTFOR" IS CALLED IN THE "SIMPLE
;METHOD".
;REGISTERS USED: NONE
020664 016767 001044 001036 RSTFOR: MOV OLDW,WIDTH ;RESTORE WIDTH
020672 016767 001040 001032 MOV OLDD,DIG ;RESTORE DIG
020700 000207 RTS PC ;RETURN
PALX 222 04/21/75 21:12:45 PAGE 39
HALIO PAL[HAL,HE] PAGE 9 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
;FLOATING POINT NUMBER TO "F" FORMAT STRING ROUTINE - "CVF"
;"CVF" - THE STRING GENERATED BY THIS ROUTINE IS SIMILAR TO "F" FORMAT
;IN FORTRAN. IT IS ASSUMED THAT THE NUMBER TO BE CONVERTED IS IN
;REGISTER AC0 AND R0 CONTAINS A POINTER TO THE FIRST BYTE OF THE
;OUTPUT STRING. THE NUMBER OF CHARACTERS WRITTEN SHOULD FIRST BE SET
;IN A CALL TO "FORMAT", ELSE THE DEFAULT VALUES ARE USED. IF THE
;INTEGER PART OF THE NUMBER EXCEEDS THE FORMAT LIMITS THE FIRST
;CHARACTER WRITTEN IS A ">". AFTER COMPLETION, "CVF" LEAVES A NULL
;CHARACTER FOLLOWING THE NUMBER STRING. REGISTER R0 IS LEFT POINTING
;AT THE NULL CHARACTER.
;REGISTERS USED:
;
; R0,AC0 PASS ARGUMENTS
; R1,AC1 GARBAGED
020702 170167 001006 CVF: LDFPS STAT ;SET THE FFP STATUS WORD
020706 016701 001016 MOV WIDTH,R1 ;GET THE TOTAL NUMBER OF CHAR TO BE WRITTEN
020712 166701 001014 SUB DIG,R1 ;DETERMINE THE MAG. OF THE M.S. DIGIT
020716 010167 001016 MOV R1,PT ;NOW HAVE # OF DIGITS BEFORE DECIMAL POINT
020722 072127 000002 ASH #2,R1 ;X 4, USE AS INDEX INTO F.P. TABLE
020726 005401 NEG R1
020730 171061 022242 MULF TENLST(R1),AC0 ;NORMALIZE NUMBER TO BETWEEN 0 AND .99999999
020734 016701 000770 MOV WIDTH,R1 ;TOTAL # OF DIGITS TO R1
020740 010246 MOV R2,-(SP) ;SAVE THE REGISTERS
020742 010346 MOV R3,-(SP)
020744 004767 000356 JSR PC,PRTF ;TYPE OUT THE DIGITS
020750 112710 000000 MOVB #0,(R0) ;PUT A NULL CHARACTER AFTER THE STRING
020754 012603 MOV (SP)+,R3 ;RESTORE THE REGISTERS
020756 012602 MOV (SP)+,R2
020760 000207 RTS PC ;RETURN
PALX 222 04/21/75 21:12:45 PAGE 40
HALIO PAL[HAL,HE] PAGE 10 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
;FLOATING POINT NUMBER TO "E" FORMAT STRING ROUTINE - "CVE"
;"CVE" - SAME OPERATION AS "CVF" EXCEPT THAT OUTPUT IN FORTRAN "E" FORMAT
020762 010246 CVE: MOV R2,-(SP) ;SAVE THE REGISTERS
020764 010346 MOV R3,-(SP)
020766 170167 000722 LDFPS STAT ;SET THE FFP STATUS WORD
020772 005067 000724 CLR EXPON ;RESET EXPONENT COUNT
020776 012767 000001 000734 MOV #1,PT ;SET COUNT TO PRINT 1 NUMBER BEFORE DECIMAL PT
021004 016701 000720 MOV WIDTH,R1 ;SET COUNT FOR TOTAL NUMBER OF DIGITS TO BE SENT
021010 162701 000004 SUB #4,R1 ;ADJUST FOR EXPONENT
021014 170500 TSTF AC0 ;CHECK IF NUMBER IS ZERO
021016 170000 CFCC ;TRANSFER CONDITIONAL CODES TO CPU
021020 001446 BEQ EPRT ;START PRINTING IF NUMBER IS 0.0
021022 174067 000676 STF AC0,NUM ;GET THE NUMBER TO BE CONVERTED
021026 005367 000670 DEC EXPON ;ADJUST EXPONENT FOR PRINTING 1 INT. DIGIT
021032 016702 000666 MOV NUM,R2 ;LOAD THE EXPONENT AND MSB OF THE NUMBER
021036 042702 100000 BIC #100000,R2 ;CONVERT TO ABSOLUTE VALUE
021042 162702 000150 SUB #150,R2 ;ADJUST EXPONENT DOWN
021046 002001 BGE .+4
021050 005002 CLR R2 ;LEAVE IT POSITIVE
021052 070227 000233 MUL #233,R2 ;USE EXPONENT AND MSB AS INDEX INTO TEN TABLE
021056 020227 000114 CMP R2,#76. ;COMPARE TO 1.0@38
021062 003402 BLE .+6
021064 012702 000114 MOV #76.,R2 ;IF LARGER, REPLACE BY 1.0@38
021070 162702 000046 SUB #38.,R2 ;SHIFT INDEX INTO RANGE OF -38 TO +38
021074 060267 000622 ADD R2,EXPON ;ADJUST EXPONENT COUNT
021100 072227 000002 ASH #2,R2 ;MULT INDEX BY 4 FOR FLOATING POINT NUMBERS
021104 005402 NEG R2
021106 171062 022242 MULF TENLST(R2),AC0 ;NORMALIZE NUMBER INTO RANGE 0.0 TO 0.9999
021112 174001 STF AC0,AC1 ;GET ABSOLUTE VALUE OF NUMBER
021114 170601 ABSF AC1
021116 173567 001120 CMPF TENLST,AC1 ;CHECK IF NUMBER LESS THAN 1.0
021122 170000 CFCC ;TRANSFER CONDITIONAL CODES TO CPU
021124 003004 BGT EPRT ;IF ITS BETWEEN 0.0 AND .99999, GO TO PNTF
021126 171067 001104 MULF TENTH,AC0 ;ELSE MULT. BY 0.1 AND ADJUST EXPONENT
021132 005267 000564 INC EXPON
PALX 222 04/21/75 21:12:45 PAGE 41
HALIO PAL[HAL,HE] PAGE 11 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
[CONTINUATION OF "CVE"]
021136 004767 000164 EPRT: JSR PC,PRTF ;GO PRINT MANTISSA
021142 112720 000105 MOVB #105,(R0)+ ;PUT A "E" CHAR INTO THE STRING
021146 112720 000053 MOVB #53,(R0)+ ;ASSUME EXPONENT POSITIVE A OUTPUT A "+"
021152 016703 000544 MOV EXPON,R3 ;TEST SIGN OF EXPONENT
021156 002004 BGE XPRT ;SKIP IF POSITIVE
021160 112760 000055 177777 MOVB #55,-1(R0) ;REPLACE "+" WITH "-"
021166 005403 NEG R3 ;MAKE EXPONENT POSITIVE
021170 005002 XPRT: CLR R2 ;CLEAR FOR DIVISION
021172 071227 000012 DIV #10.,R2 ;SEPARATES TENS AND UNITS DIGIT
021176 052702 000060 BIS #60,R2 ;CONVERT TO ASC AND PUT IN I/O BUFFER
021202 110220 MOVB R2,(R0)+
021204 052703 000060 BIS #60,R3
021210 110320 MOVB R3,(R0)+
021212 112710 000000 MOVB #0,(R0) ;PUT IN A NULL CHARACTER
021216 012603 MOV (SP)+,R3 ;RESTORE THE REGISTERS
021220 012602 MOV (SP)+,R2
021222 000207 RTS PC ;RETURN
PALX 222 04/21/75 21:12:45 PAGE 42
HALIO PAL[HAL,HE] PAGE 12 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
;FLOATING POINT NUMBER TO "E" OR "F" FORMAT STRING - "CVG"
;"CVG" - DETERMINES IF THE NUMBER IN AC0 CAN BE WRITTEN BY "CVF", IF
;IT CAN, THEN CVF IS CALLED, ELSE THE NUMBER IS PRINTED USING "CVE".
021224 170167 000464 CVG: LDFPS STAT ;LOAD THE FFP STATUS WORD
021230 172500 LDF AC0,AC1 ;COPY THE NUMBER
021232 170000 CFCC ;TRANSFER THE CONDITIONAL CODES TO CPU
021234 170601 ABSF AC1 ;CONVERT NUMBER TO ABSOLUTE VALUES
021236 001430 BEQ RUNF ;IF NUMBER = 0.0, EXECUTE CVF
021240 016701 000466 MOV DIG,R1 ;GET THE NUMBER OF DECIMAL DIGITS TO BE TYPED
021244 072127 000002 ASH #2,R1 ;MULT BY 4 TO USE A FLOATING POINT INDEX
021250 171161 022242 MULF TENLST(R1),AC1 ;CHECK IF NUMBER SMALLER THAN 1.0@-DIG
021254 173567 000762 CMPF TENLST,AC1 ;COMPARE TO 1.0
021260 170000 CFCC ;TRANSFER CONDITIONAL CODES TO CPU
021262 003013 BGT RUNE ;IF LESS THAN 1.0@-DIG, PRINT USING CVE
021264 016701 000440 MOV WIDTH,R1 ;GET THE TOTAL NUMBER OF DIGITS TO BE PRINTED
021270 072127 000002 ASH #2,R1 ;USE THIS AS A F.P. INDEX
021274 005401 NEG R1
021276 171161 022242 MULF TENLST(R1),AC1 ;CHECK IF GREATER THAN WIDTH-DIG LONG
021302 173567 000734 CMPF TENLST,AC1 ;COMPARE TO 1.0
021306 170000 CFCC ;TRANSFER CONDITIONAL CODES
021310 002003 BGE RUNF ;IF TOO LARGE, USE CVE
021312 004767 177444 RUNE: JSR PC,CVE
021316 000207 RTS PC
021320 004767 177356 RUNF: JSR PC,CVF
021324 000207 RTS PC
PALX 222 04/21/75 21:12:45 PAGE 43
HALIO PAL[HAL,HE] PAGE 13 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
; PRINTING ROUTINE USED BY "CVF" & "CVE"
021326 170500 PRTF: TSTF AC0 ;TEST THE SIGN OF THE NUMBER
021330 112767 000040 000360 MOVB #40,MSIGN ;ASSUME SIGN POSITIVE
021336 170000 CFCC ;TRANSFER THE CONDITIONAL CODES TO CPU
021340 170600 ABSF AC0 ;CLEAR THE SIGN OF THE NUMBER
021342 002003 BGE .+10
021344 112767 000055 000344 MOVB #55,MSIGN ;IF NEGATIVE PUT IN "-" SIGN
021352 171467 000670 MODF TEN,AC0 ;COMPUTE M.S. INTEGER DIGIT
021356 005003 CLR R3 ;INDICATE SIGN NOT YET WRITTEN
021360 005767 000354 DIGLP: TST PT ;CHECK IF TIME TO PRINT DECIMAL POINT
021364 001007 BNE GETDG ;SKIP IF NOT
021366 005703 TST R3 ;HAVE WE PRINTED SIGN YET?
021370 001003 BNE WTDP ;SKIP IF WE HAVE
021372 116720 000320 MOVB MSIGN,(R0)+ ;ELSE PRINT SIGN BEFORE DECIMAL POINT
021376 005203 INC R3 ;INDICATE SIGN PRINTED
021400 112720 000056 WTDP: MOVB #56,(R0)+ ;PRINT DECIMAL POINT
021404 175502 GETDG: STCFI AC1,R2 ;SAVE M.S. INTEGER DIGIT
021406 170000 CFCC ;CHECK FOR NUMBER TOO LARGE TO INTEGERIZE
021410 103015 BCC CHKSZ
021412 172001 TOLGE: ADDF AC1,AC0 ;IF TWO LARGE, PUT IT BACK TOGETHER
021414 171467 000616 MODF TENTH,AC0 ;SCALE DOWN AND TRY INTEGERIZING AGAIN
021420 005201 INC R1 ;PRINT OUT ONE MORE DIGIT
021422 005267 000312 INC PT ;SHIFT DECIMAL POINT TO PUT IN EXTRA DIGIT
021426 005703 TST R3 ;CHECK IF SIGN AND D.P. ALREADY WRITTEN
021430 001765 BEQ GETDG ;GO CHECK IF IN RANGE IF NOT WRITTEN
021432 005003 CLR R3 ;CLEAR SIGN AND D.P.
021434 162700 000002 SUB #2,R0 ;ADJUST BYTE POINTER
021440 000167 177740 JMP GETDG ;GO CHECK IF IN RANGE AGAIN
021444 005702 CHKSZ: TST R2 ;TEST INTEGER
021446 002761 BLT TOLGE ;IF TOO LARGE, GO SCALE AGAIN
021450 020227 000011 CMP R2,#9. ;CHECK IF LESS THAN 9
021454 003356 BGT TOLGE ;SCALE IF GREATER THAN 9
021456 171467 000564 MODF TEN,AC0 ;START COMPUTING NEXT INTEGER DIGIT
021462 005703 TST R3 ;HAVE WE PRINTED SIGN YET?
021464 001005 BNE SETBS ;SKIP IF WE HAVE
021466 005702 TST R2 ;CHECK IF LEADING ZERO
021470 001407 BEQ WTSP ;IF IT IS GO WRITE A SPACE CHARACTER
021472 116720 000220 MOVB MSIGN,(R0)+ ;FIRST CHARACTER, NOW PRINT SIGN
021476 005203 INC R3 ;INDICATE SIGN PRINTED
021500 052702 000060 SETBS: BIS #60,R2 ;SET ASC ZERO BASE
021504 000167 000004 JMP WTCH
021510 112702 000040 WTSP: MOVB #40,R2 ;WRITE A SPACE CHARACTER
021514 110220 WTCH: MOVB R2,(R0)+ ;PUT CHARACTER IN I/O BUFFER
021516 005367 000216 DEC PT ;DECREMENT DECIMAL POINT COUNT
021522 077162 SOB R1,DIGLP ;DONE WITH CHARACTERS?
021524 000207 RTS PC ;RETURN
PALX 222 04/21/75 21:12:45 PAGE 44
HALIO PAL[HAL,HE] PAGE 14 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
;This is the end of the floating package.
.ENDC
PALX 222 04/21/75 21:12:45 PAGE 45
HALIO PAL[HAL,HE] PAGE 15 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
;VT05 INPUT ROUTINE - "INSTR"
;STRING BYTE POINTER MUST BE IN R0. A CARRIAGE RETURN IS ASSUMED TO
;BE THE ACTIVATION CHARACTER. A RUB OUT IS A DELETING BACKSPACE
;CHARACTER. AT THE COMPLETION OF THIS ROUTINE A NULL CHARACTER IS
;PLACED IN THE INPUT STRING. R0 THEN POINTS TO THE NULL CHARACTER.
;REGISTERS USED:
;
; R0 PASSES ARGUMENT
; R1 GARBAGED
021526 005067 000154 INSTR: CLR CCNT ;RESET CHARACTER COUNT
021532 105767 156022 IN2: TSTB KBIS ;TEST IF KEYBOARD READY
021536 001775 BEQ .-4 ;WAIT TILL IT IS
021540 116701 156016 MOVB KBIR,R1 ;GET A CHARACTER
021544 042701 177600 BIC #177600,R1 ;MASK OFF - MAKE IT 7 BITS
021550 020127 000177 CMP R1,#177 ;COMPARE TO BS CHARACTER
021554 001020 BNE IN3 ;SKIP IF ITS NOT
021556 005767 000124 TST CCNT ;CHECK IF ANY CHARACTERS IN BUFFER
021562 001763 BEQ IN2 ;FORGET BACK SPACE IF NO CHAR.
021564 005300 DEC R0 ;REMOVE LAST CHARACTER IN BUFFER
021566 005367 000114 DEC CCNT ;DECREMENT CHARACTER COUNT
OUTSTR DBS ;PERFORM A DELETING BACKSPACE
021572 010046 MOV R0,-(SP) ;Save R0. Who knows what was happening in it?
021574 010146 MOV R1,-(SP) ;Save R1.
021576 012700 021710 MOV #DBS,R0 ;Load up the string to be output
021602 004767 176172 JSR PC,TYPSTR ;Call the string output utility routine.
021606 012601 MOV (SP)+,R1 ;Restore R1.
021610 012600 MOV (SP)+,R0 ;Restore R0.
021612 000167 177714 JMP IN2
021616 020127 000015 IN3: CMP R1,#15 ;COMPARE TO CR CHARACTER
021622 001415 BEQ IN4 ;CONTINUE READING IF ITS NOT A CR
021624 020127 000040 CMP R1,#40 ;CHECK IF CHARACTER LEGAL
021630 002740 BLT IN2 ;IGNOR IF IT IS
021632 110120 MOVB R1,(R0)+ ;SAVE THE CHARACTER
021634 005267 000046 INC CCNT ;INCREMENT CHARACTER COUNT
021640 105767 155720 TSTB KBOS ;ECHO THE CHARACTER
021644 100375 BPL .-4 ;WAIT TILL TTY READY
021646 110167 155714 MOVB R1,KBOR ;WRITE THE CHARACTER
021652 000167 177654 JMP IN2 ;CONTINUE READING
IN4: CRLF ;IF IT IS A CR, TYPE A CR AND LF
OUTSTR CRLFX ;Carriage return, line feed.
021656 010046 MOV R0,-(SP) ;Save R0. Who knows what was happening in it?
021660 010146 MOV R1,-(SP) ;Save R1.
021662 012700 020126 MOV #CRLFX,R0 ;Load up the string to be output
021666 004767 176106 JSR PC,TYPSTR ;Call the string output utility routine.
021672 012601 MOV (SP)+,R1 ;Restore R1.
021674 012600 MOV (SP)+,R0 ;Restore R0.
PALX 222 04/21/75 21:12:45 PAGE 46
HALIO PAL[HAL,HE] PAGE 15.1 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
021676 110120 MOVB R1,(R0)+ ;PUT A CR IN THE STRING
021700 112710 000000 MOVB #0,(R0) ;PUT IN A NULL CHARACTER
021704 000207 RTS PC ;RETURN
021706 000000 CCNT: 0
021710 010
021711 040
021712 010
021713 000 DBS: .BYTE 10,40,10,0
PALX 222 04/21/75 21:12:45 PAGE 47
HALIO PAL[HAL,HE] PAGE 16 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
;LOCAL STORAGE AREA
021714 000000 STAT: 0 ;FLOATING HARDWARE STATUS WORD
021716 000000 MSIGN: 0 ;SIGN OF CURRENT NUMBER
021720 000000 ESIGN: 0 ;SIGN OF EXPONENT
021722 000000 EXPON: 0
021724 000000
021726 000000 NUM: .WORD 0,0
021730 000010 WIDTH: 8. ;DEFAULT NUMBER OF CHARACTERS IN OUTPUT STRING
021732 000003 DIG: 3 ;DEFAULT NUMBER OF DECIMAL DIGITS
021734 000010 OLDW: 8. ;OLD VALUES OF WIDTH AND DIG
021736 000003 OLDD: 3
021740 000000 PT: 0 ;NUMBER OF DIGITS BEFORE DECIMAL POINT
;TABLE OF F.P. DIGITS FROM 0.0 TO 0.9
021742 000000
021744 000000
021746 040200
021750 000000
021752 040400
021754 000000
021756 040500
021760 000000 DGLST: .WORD 0, 0, 40200, 0, 40400, 0, 40500, 0
021762 040600
021764 000000
021766 040640
021770 000000
021772 040700
021774 000000
021776 040740
022000 000000 .WORD 40600, 0, 40640, 0, 40700, 0, 40740, 0
022002 041000
022004 000000
022006 041020
022010 000000 .WORD 41000, 0, 41020, 0
;TABLE OF POWERS OF TEN
022012 000531
022014 143735
022016 001410
022020 016352
022022 002252
022024 022044
022026 003124
022030 126455 .WORD 531,143735, 1410, 16352, 2252, 22044, 3124,126455
022032 004004
022034 166074
PALX 222 04/21/75 21:12:45 PAGE 48
HALIO PAL[HAL,HE] PAGE 16.1 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
022036 004646
022040 023513
022042 005517
022044 130436
022046 006401
022050 147263 .WORD 4004,166074, 4646, 23513, 5517,130436, 6401,147263
022052 007242
022054 041140
022056 010112
022060 151370
022062 010775
022064 103666
022066 011636
022070 072321 .WORD 7242, 41140, 10112,151370, 10775,103666, 11636, 72321
022072 012506
022074 011006
022076 013367
022100 113210
022102 014232
022104 137025
022106 015101
022110 066632 .WORD 12506, 11006, 13367,113210, 14232,137025, 15101, 66632
022112 015761
022114 144400
022116 016627
022120 016640
022122 017474
022124 162410
022126 020354
022130 017112 .WORD 15761,144400, 16627, 16640, 17474,162410, 20354, 17112
022132 021223
022134 111356
022136 022070
022140 073652
022142 022746
022144 112625
022146 023620
022150 016575 .WORD 21223,111356, 22070, 73652, 22746,112625, 23620, 16575
022152 024464
022154 022334
022156 025341
022160 027023
022162 026214
022164 136314
022166 027057
022170 165777 .WORD 24464, 22334, 25341, 27023, 26214,136314, 27057,165777
022172 027733
022174 163377
022176 030611
PALX 222 04/21/75 21:12:45 PAGE 49
HALIO PAL[HAL,HE] PAGE 16.2 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
022200 070137
022202 031453
022204 146167
022206 032326
022210 137625 .WORD 27733,163377, 30611, 70137, 31453,146167, 32326,137625
022212 033206
022214 033675
022216 034047
022220 142654
022222 034721
022224 133430
022226 035603
022230 011157 .WORD 33206, 33675, 34047,142654, 34721,133430, 35603, 11157
022232 036443
022234 153412 .WORD 36443,153412
022236 037314
022240 146315 TENTH: .WORD 37314,146315
022242 040200
022244 000000 TENLST: .WORD 40200, 0
022246 041040
022250 000000 TEN: .WORD 41040, 0
022252 041710
022254 000000
022256 042572
022260 000001
022262 043434
022264 040000
022266 044303
022270 050000 .WORD 41710, 0, 42572, 1, 43434, 40000, 44303, 50000
022272 045164
022274 022001
022276 046030
022300 113200
022302 046676
022304 136040
022306 047556
022310 065451 .WORD 45164, 22001, 46030,113200, 46676,136040, 47556, 65451
022312 050425
022314 001371
022316 051272
022320 041670
022322 052150
022324 152246
022326 053021
022330 102347 .WORD 50425, 1371, 51272, 41670, 52150,152246, 53021,102347
022332 053665
022334 163041
022336 054543
022340 057652
PALX 222 04/21/75 21:12:45 PAGE 50
HALIO PAL[HAL,HE] PAGE 16.3 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
022342 055416
022344 015712
022346 056261
022350 121275 .WORD 53665,163041, 54543, 57652, 55416, 15712, 56261,121275
022352 057136
022354 005554
022356 060012
022360 143443
022362 060655
022364 074354
022366 061530
022370 153447 .WORD 57136, 5554, 60012,143443, 60655, 74354, 61530,153447
022372 062407
022374 103170
022376 063251
022400 064027
022402 064123
022404 141034
022406 065004
022410 054522 .WORD 62407,103170, 63251, 64027, 64123,141034, 65004, 54522
022412 065645
022414 067646
022416 066516
022420 145620
022422 067401
022424 037472
022426 070241
022430 107410 .WORD 65645, 67646, 66516,145620, 67401, 37472, 70241,107410
022432 071111
022434 171312
022436 071774
022440 067575
022442 072635
022444 142656
022446 073505
022450 033432 .WORD 71111,171312, 71774, 67575, 72635,142656, 73505, 33432
022452 074366
022454 102340
022456 075232
022460 011414
022462 076100
022464 113717
022466 076760
022470 136703 .WORD 74366,102340, 75232, 11414, 76100,113717, 76760,136703
022472 077626
022474 073232 .WORD 77626, 73232
;System line buffers
PALX 222 04/21/75 21:12:45 PAGE 51
HALIO PAL[HAL,HE] PAGE 16.4 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
022622 INBUF: .BLKW 42.
022746 OUTBUF: .BLKW 42.
PALX 222 04/21/75 21:12:45 PAGE 52
HALRTR PAL[HAL,HE] PAGE 2.1 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
.INSRT HALRTR.PAL[HAL,HE]
PALX 222 04/21/75 21:12:45 PAGE 53
HALRTR PAL[HAL,HE] PAGE 1 FLOATING POINT TO/FROM STRING CONVERSION ROUTINES
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 .SBTTL Free storage management GTFREE, RLFREE
C00009 ENDMK
C⊗;
PALX 222 04/21/75 21:12:45 PAGE 54
HALRTR PAL[HAL,HE] PAGE 2 Free storage management GTFREE, RLFREE
.SBTTL Free storage management GTFREE, RLFREE
; Assembly variables
004000 FREL = 4000 ;Test of small amount. Maximum = 40000 (IN WORDS!)
; Free storage block
022746 .EVEN
022746 022752 FREEPT: FREEST
022750 177777 -1 ;Left bdry tag is negative.
022752 010000 FREEST: FREL*2 ;Beginning of free storage. Boundary tag.
032750 .BLKW FREL-2 ;
032750 010000 FREEND: FREL*2 ;End of free storage. Boundary tag.
032752 177777 -1 ;Right bdry tag is negative.
; Routine to initialize storage. Need only call if you think
; storage has been munged, or you want to start over for
; some reason.
032754 012767 010000 167770 FRINIT: MOV #FREL*2,FREEST ;Lower inner tag
032762 012767 010000 177760 MOV #FREL*2,FREEND ;Upper inner tag
032770 012767 022752 167750 MOV #FREEST,FREEPT ;Roving free pointer
032776 026767 167746 177746 CMP FREEST-2,FREEND+2 ;Do the two outer tags agree?
033004 001001 BNE FRINER ;No.
033006 000207 RTS PC ;Yes. Return.
FRINER: HALERR FRINMS
033010 010046 MOV R0,-(SP) ;Save R0.
033012 010146 MOV R1,-(SP) ;Save R1.
033014 012700 020126 MOV #CRLFX,R0 ;Move to new line
033020 004767 164754 JSR PC,TYPSTR ;
033024 012700 033052 MOV #FRINMS,R0 ;Type out message
033030 004767 164744 JSR PC,TYPSTR ;
033034 012700 020131 MOV #RUGMES,R0 ;Type out RUGMES
033040 004767 164734 JSR PC,TYPSTR ;
033044 012601 MOV (SP)+,R1 ;Restore R1.
033046 012600 MOV (SP)+,R0 ;Restore R2.
033050 000003 BPT ;Breakpoint to DDT.
FRINMS: ASCIE /FRINIT FEARS FREE STORAGE HAS BEEN MUNGED/
033052 106
033053 122
033054 111
033055 116
033056 111
033057 124
033060 040
033061 106
033062 105
033063 101
033064 122
033065 123
033066 040
PALX 222 04/21/75 21:12:45 PAGE 55
HALRTR PAL[HAL,HE] PAGE 2.1 Free storage management GTFREE, RLFREE
033067 106
033070 122
033071 105
033072 105
033073 040
033074 123
033075 124
033076 117
033077 122
033100 101
033101 107
033102 105
033103 040
033104 110
033105 101
033106 123
033107 040
033110 102
033111 105
033112 105
033113 116
033114 040
033115 115
033116 125
033117 116
033120 107
033121 105
033122 104
033123 000
.ASCIZ /FRINIT FEARS FREE STORAGE HAS BEEN MUNGED/
033124 .EVEN
; Routine to assign storage. Amount of words requested in R0.
; Location of first word in block (not the boundary tag) returned
; in R0.
; The boundary tag method described in Knuth I.2.5 is
; used. Each block of storage has a boundary tag at
; each end, with identical contents: The number
; of bytes in the whole area if available, and the opposite
; of that if busy. Artificial busy areas above and below
; free storage.
033124 010246 GTFREE: MOV R2,-(SP) ;Save R2 on stack.
033126 006300 ASL R0 ;Convert words to bytes
033130 002454 BLT FREERR ;Asked for negative number of words.
033132 062700 000004 ADD #4, R0 ;Need 2 extra words for boundary tags
033136 016701 167604 MOV FREEPT, R1 ;R1 ← running LOC[LTAG[*]]
033142 020127 032750 FRTRY: CMP R1,#FREEND ;Are we off the end of free storage?
033146 101402 BLOS FR2 ;No.
033150 012701 022752 MOV #FREEST,R1 ;Yes. Reset pointer to beginning.
PALX 222 04/21/75 21:12:45 PAGE 56
HALRTR PAL[HAL,HE] PAGE 2.2 Free storage management GTFREE, RLFREE
033154 021100 FR2: CMP (R1),R0 ;Do we have enough room here?
033156 002011 BGE FFOUND ;Yes
033160 005711 TST (R1) ;No. Is this area busy? If so, its count is negative.
033162 002002 BGE FRPOS ;No.
033164 161101 SUB (R1),R1 ;Yes. R1 ← LOC[LTAG[next] by subtraction.
033166 000401 BR FR1
033170 061101 FRPOS: ADD (R1),R1 ;R1 ← LOC[LTAG[next] by addition.
033172 020167 167550 FR1: CMP R1,FREEPT ;Have we cycled all through free storage
033176 001452 BEQ FROVFL ;Yes. No room!
033200 000760 BR FRTRY ;No. Try again.
033202 001422 FFOUND: BEQ FEXACT ;If 0, then exact fit.
033204 010102 MOV R1,R2 ;Divide the found block into FOUND and HOLE.
;Thus, R1 = LOC[LTAG[FOUND]].
033206 060002 ADD R0,R2 ;R2 ← LOC[LTAG[HOLE]]
033210 005400 NEG R0 ;R0 ← negative (busy) count of FOUND.
033212 010062 177776 MOV R0,-2(R2) ;RTAG[FOUND] ← new FOUND count.
033216 010046 MOV R0,-(SP) ;Save R0.
033220 061100 ADD (R1),R0 ;R0 ← new HOLE count.
033222 010012 MOV R0,(R2) ;LTAG[HOLE] ← new HOLE count.
033224 010267 167516 MOV R2,FREEPT ;Free pointer ← LOC[LTAG[HOLE]]
033230 010102 MOV R1,R2 ;
033232 005742 TST -(R2) ;
033234 061102 ADD (R1),R2 ;R2 ← LOC[RTAG[HOLE]].
033236 010012 MOV R0,(R2) ;RTAG[HOLE] ← new HOLE count.
033240 012621 MOV (SP)+,(R1)+ ;LTAG[FOUND] ← new FOUND count.
033242 010100 FRRET: MOV R1,R0 ;R0 (result) ← LOC[LTAG[FOUND]] + 1.
033244 012602 MOV (SP)+,R2 ;Restore R2
033246 000207 RTS PC ;Done.
033250 010102 FEXACT: MOV R1,R2 ;
033252 061102 ADD (R1),R2 ;R2 ← LOC[RTAG[FOUND]]
033254 005421 NEG (R1)+ ;LTAG[FOUND] ← new (busy) count.
033256 005442 NEG -(R2) ;RTAG[FOUND] ← new (busy) count.
033260 000770 BR FRRET ;Ready to return
FREERR: HALERR FRMS1
033262 010046 MOV R0,-(SP) ;Save R0.
033264 010146 MOV R1,-(SP) ;Save R1.
033266 012700 020126 MOV #CRLFX,R0 ;Move to new line
033272 004767 164502 JSR PC,TYPSTR ;
033276 012700 033366 MOV #FRMS1,R0 ;Type out message
033302 004767 164472 JSR PC,TYPSTR ;
033306 012700 020131 MOV #RUGMES,R0 ;Type out RUGMES
033312 004767 164462 JSR PC,TYPSTR ;
033316 012601 MOV (SP)+,R1 ;Restore R1.
033320 012600 MOV (SP)+,R0 ;Restore R2.
033322 000003 BPT ;Breakpoint to DDT.
FROVFL: HALERR FRMS2
033324 010046 MOV R0,-(SP) ;Save R0.
033326 010146 MOV R1,-(SP) ;Save R1.
033330 012700 020126 MOV #CRLFX,R0 ;Move to new line
PALX 222 04/21/75 21:12:45 PAGE 57
HALRTR PAL[HAL,HE] PAGE 2.3 Free storage management GTFREE, RLFREE
033334 004767 164440 JSR PC,TYPSTR ;
033340 012700 033442 MOV #FRMS2,R0 ;Type out message
033344 004767 164430 JSR PC,TYPSTR ;
033350 012700 020131 MOV #RUGMES,R0 ;Type out RUGMES
033354 004767 164420 JSR PC,TYPSTR ;
033360 012601 MOV (SP)+,R1 ;Restore R1.
033362 012600 MOV (SP)+,R0 ;Restore R2.
033364 000003 BPT ;Breakpoint to DDT.
FRMS1: ASCIE </YOU ASKED FOR NEGATIVE AMOUNT OF FREE SPACE/>
033366 131
033367 117
033370 125
033371 040
033372 101
033373 123
033374 113
033375 105
033376 104
033377 040
033400 106
033401 117
033402 122
033403 040
033404 116
033405 105
033406 107
033407 101
033410 124
033411 111
033412 126
033413 105
033414 040
033415 101
033416 115
033417 117
033420 125
033421 116
033422 124
033423 040
033424 117
033425 106
033426 040
033427 106
033430 122
033431 105
033432 105
033433 040
033434 123
033435 120
PALX 222 04/21/75 21:12:45 PAGE 58
HALRTR PAL[HAL,HE] PAGE 2.4 Free storage management GTFREE, RLFREE
033436 101
033437 103
033440 105
033441 000
.ASCIZ /YOU ASKED FOR NEGATIVE AMOUNT OF FREE SPACE/
033442 .EVEN
FRMS2: ASCIE /FREE STORAGE EXHAUSTED/
033442 106
033443 122
033444 105
033445 105
033446 040
033447 123
033450 124
033451 117
033452 122
033453 101
033454 107
033455 105
033456 040
033457 105
033460 130
033461 110
033462 101
033463 125
033464 123
033465 124
033466 105
033467 104
033470 000
.ASCIZ /FREE STORAGE EXHAUSTED/
033472 .EVEN
; Routine to release free storage. R0=LOC[LTAG[BLOCK]] + 1.
; Call the currently released block BLOCK, the adjacent one
; below LOW, and the adjacent one above HIGH.
033472 014001 RLFREE: MOV -(R0),R1 ;R1 ← LOC[LTAG[BLOCK]]
033474 002057 BGE RLFER2 ;Can't release available space.
033476 010001 MOV R0,R1 ;R1 ← LOC[LTAG[BLOCK]]
033500 161000 SUB (R0),R0 ;R0 ← LOC[LTAG[HIGH]]
033502 021160 177776 CMP (R1),-2(R0) ;Do the two bdry tags agree?
033506 001031 BNE RLFER1 ;No. Storage munged!!
033510 005411 NEG (R1) ;Count is now positive in LTAG[BLOCK].
033512 005761 177776 TST -2(R1) ;Is LOW available?
033516 002411 BLT MERGR ;No. Cannot merge left.
033520 066111 177776 ADD -2(R1),(R1) ;Yes. LTAG[BLOCK] ← New count
033524 011160 177776 MOV (R1),-2(R0) ;RTAG[BLOCK] ← New count
033530 010001 MOV R0,R1 ;
PALX 222 04/21/75 21:12:45 PAGE 59
HALRTR PAL[HAL,HE] PAGE 2.5 Free storage management GTFREE, RLFREE
033532 166101 177776 SUB -2(R1),R1 ;R1 ← LOC[LTAG[LOW]]
033536 016011 177776 MOV -2(R0),(R1) ;LTAG[LOW] ← New count
;At this point, call LOW&BLOCK = BLOCK.
033542 005710 MERGR: TST (R0) ;Is HIGH available?
033544 002407 BLT RLRET ;No. Prepare to return.
033546 061011 ADD (R0),(R1) ;LTAG[BLOCK] ← New count
033550 026700 167172 CMP FREEPT,R0 ;Will FREEPT point into a vacuum?
033554 001002 BNE RL1 ;No.
033556 010167 167164 MOV R1,FREEPT ;Yes. Reset FREEPT ← LOC[LTAG[BLOCK]]
033562 061000 RL1: ADD (R0),R0 ;R0 ← LOC[RTAG[HIGH]] + 1
;At this point, call BLOCK&HIGH = BLOCK.
033564 011160 177776 RLRET: MOV (R1),-2(R0) ;RTAG[BLOCK] ← New count
033570 000207 RTS PC ;Done.
RLFER1: HALERR RLMS1
033572 010046 MOV R0,-(SP) ;Save R0.
033574 010146 MOV R1,-(SP) ;Save R1.
033576 012700 020126 MOV #CRLFX,R0 ;Move to new line
033602 004767 164172 JSR PC,TYPSTR ;
033606 012700 033676 MOV #RLMS1,R0 ;Type out message
033612 004767 164162 JSR PC,TYPSTR ;
033616 012700 020131 MOV #RUGMES,R0 ;Type out RUGMES
033622 004767 164152 JSR PC,TYPSTR ;
033626 012601 MOV (SP)+,R1 ;Restore R1.
033630 012600 MOV (SP)+,R0 ;Restore R2.
033632 000003 BPT ;Breakpoint to DDT.
RLFER2: HALERR RLMS2
033634 010046 MOV R0,-(SP) ;Save R0.
033636 010146 MOV R1,-(SP) ;Save R1.
033640 012700 020126 MOV #CRLFX,R0 ;Move to new line
033644 004767 164130 JSR PC,TYPSTR ;
033650 012700 033746 MOV #RLMS2,R0 ;Type out message
033654 004767 164120 JSR PC,TYPSTR ;
033660 012700 020131 MOV #RUGMES,R0 ;Type out RUGMES
033664 004767 164110 JSR PC,TYPSTR ;
033670 012601 MOV (SP)+,R1 ;Restore R1.
033672 012600 MOV (SP)+,R0 ;Restore R2.
033674 000003 BPT ;Breakpoint to DDT.
RLMS1: ASCIE /RLFREE FEARS FREE STORAGE IS WIPED OUT/
033676 122
033677 114
033700 106
033701 122
033702 105
033703 105
033704 040
033705 106
033706 105
033707 101
033710 122
PALX 222 04/21/75 21:12:45 PAGE 60
HALRTR PAL[HAL,HE] PAGE 2.6 Free storage management GTFREE, RLFREE
033711 123
033712 040
033713 106
033714 122
033715 105
033716 105
033717 040
033720 123
033721 124
033722 117
033723 122
033724 101
033725 107
033726 105
033727 040
033730 111
033731 123
033732 040
033733 127
033734 111
033735 120
033736 105
033737 104
033740 040
033741 117
033742 125
033743 124
033744 000
.ASCIZ /RLFREE FEARS FREE STORAGE IS WIPED OUT/
033746 .EVEN
RLMS2: ASCIE /ATTEMPT TO FREE ALREADY AVAILABLE SPACE/
033746 101
033747 124
033750 124
033751 105
033752 115
033753 120
033754 124
033755 040
033756 124
033757 117
033760 040
033761 106
033762 122
033763 105
033764 105
033765 040
033766 101
033767 114
PALX 222 04/21/75 21:12:45 PAGE 61
HALRTR PAL[HAL,HE] PAGE 2.7 Free storage management GTFREE, RLFREE
033770 122
033771 105
033772 101
033773 104
033774 131
033775 040
033776 101
033777 126
034000 101
034001 111
034002 114
034003 101
034004 102
034005 114
034006 105
034007 040
034010 123
034011 120
034012 101
034013 103
034014 105
034015 000
.ASCIZ /ATTEMPT TO FREE ALREADY AVAILABLE SPACE/
034016 .EVEN
PALX 222 04/21/75 21:12:45 PAGE 62
TEST1 PAL[HAL,HE] PAGE 2.1 Free storage management GTFREE, RLFREE
;INSRT GRAPHS.PAL[HAL,HE]
;INSRT FBUG.PAL[1,BES]
;INSRT ARITH.PAL[HAL,HE]
.INSRT INTERP.PAL[HAL,HE]
PALX 222 04/21/75 21:12:45 PAGE 63
INTERP PAL[HAL,HE] PAGE 1 Free storage management GTFREE, RLFREE
COMMENT ⊗ VALID 00012 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 .SBTTL Interpreter
C00007 00003 Interpreter itself: INTERP
C00012 00004 GETARG, GETSCA, GETVEC, GETTRN, GETVAL
C00016 00005 Variable declaration: VARIABLE
C00017 00006 Stack ops: GTVAL, CHNGE, PUSH, POP, COPY, REPLACE, FLUSH
C00020 00007 Flow-of-control: PROC, RETURN
C00026 00008 FORCHK, SPROUT, JUMP, JUMPZ, TERMINATE
C00034 00009 return scalars: SADD, SSUB, SMUL, SDIV, SNEG, VDOT, PVDOT, VMAG
C00040 00010 Vector utilities: UNITV, CROSV
C00046 00011 Return vectors: SVMUL, TVMUL, VMAKE, VADD
C00050 00012 Return a trans: TMAKE, TTMUL
C00054 ENDMK
C⊗;
PALX 222 04/21/75 21:12:45 PAGE 64
INTERP PAL[HAL,HE] PAGE 2 Interpreter
.SBTTL Interpreter
;Register uses in the interpreter:
; R3 interpreter stack pointer
; R4 points to interpreter status block
;Each interpreter has a stack which it uses to store pointers to
;currently "open" variables. During the course of a calculation,
;operands and temporary result cells will be open in this fashion.
;The "interpreter stack" is pointed to by R3. When a new interpreter
;is sprouted, it is given a new stack area. Each interpreter has
;certain status information which facilitates transfer of control
;between interpreters. This information is kept in the interpreter
;status block, which is always pointed to by R4. Most important are
;the IPC, the Interpreter Program Counter, the ENV, which points to
;the local environment, and LEV, which stores the current lexical
;level.
;Each procedure has an environment, which is a data area holding
;information vital to that procedure. This includes pointers to all
;the variables local to that procedure, and return information.
000020 INSTSZ == 20 ;Size of an interpreter stack
;Interpreter status block
000000 II == 0
XX IPC ;Interpreter program counter
.IFDF IPC
.IF1
.ERROR You are using IPC in two ways!!!
.ENDC
.ENDC
000000 IPC == II
000002 II == II+2
XX STKBAS ;Location of start of stack area. Needed
.IFDF STKBAS
.IF1
.ERROR You are using STKBAS in two ways!!!
.ENDC
.ENDC
000002 STKBAS == II
000004 II == II+2
;for eventual reclamation.
XX ICR ;Interpreter cross-reference (to HAL code)
.IFDF ICR
.IF1
.ERROR You are using ICR in two ways!!!
.ENDC
.ENDC
PALX 222 04/21/75 21:12:45 PAGE 65
INTERP PAL[HAL,HE] PAGE 2.1 Interpreter
000004 ICR == II
000006 II == II+2
XX ENV ;Location of local environment
.IFDF ENV
.IF1
.ERROR You are using ENV in two ways!!!
.ENDC
.ENDC
000006 ENV == II
000010 II == II+2
XX LEV ;Lexical level of current execution
.IFDF LEV
.IF1
.ERROR You are using LEV in two ways!!!
.ENDC
.ENDC
000010 LEV == II
000012 II == II+2
XX STA ;Status bits for condition codes: 0 means all well.
.IFDF STA
.IF1
.ERROR You are using STA in two ways!!!
.ENDC
.ENDC
000012 STA == II
000014 II == II+2
XX PCB ;Location of process control block (for reclamation)
.IFDF PCB
.IF1
.ERROR You are using PCB in two ways!!!
.ENDC
.ENDC
000014 PCB == II
000016 II == II+2
XX EVT ;The event to signal as this interpreter goes away
.IFDF EVT
.IF1
.ERROR You are using EVT in two ways!!!
.ENDC
.ENDC
000016 EVT == II
000020 II == II+2
000010 ISBS == II/2 ;Size (in words) of interpreter status block
;Fixed fields in the environment of each process
000000 II == 0
XX SLINK ;Pointer to environment of next (outer, lower
.IFDF SLINK
.IF1
PALX 222 04/21/75 21:12:45 PAGE 66
INTERP PAL[HAL,HE] PAGE 2.2 Interpreter
.ERROR You are using SLINK in two ways!!!
.ENDC
.ENDC
000000 SLINK == II
000002 II == II+2
; numbered) block
XX OLEV ;Old level. The lexical level of calling process.
.IFDF OLEV
.IF1
.ERROR You are using OLEV in two ways!!!
.ENDC
.ENDC
000002 OLEV == II
000004 II == II+2
XX OENV ;Old environment, the one for the calling process.
.IFDF OENV
.IF1
.ERROR You are using OENV in two ways!!!
.ENDC
.ENDC
000004 OENV == II
000006 II == II+2
XX OIPC ;Old IPC. Program counter for calling process.
.IFDF OIPC
.IF1
.ERROR You are using OIPC in two ways!!!
.ENDC
.ENDC
000006 OIPC == II
000010 II == II+2
XX LVARS ;First location where pointers to local variables go
.IFDF LVARS
.IF1
.ERROR You are using LVARS in two ways!!!
.ENDC
.ENDC
000010 LVARS == II
000012 II == II+2
PALX 222 04/21/75 21:12:45 PAGE 67
INTERP PAL[HAL,HE] PAGE 3 Interpreter
;Interpreter itself: INTERP
INTERP:
OUTSTR HELLO ;
034016 010046 MOV R0,-(SP) ;Save R0. Who knows what was happening in it?
034020 010146 MOV R1,-(SP) ;Save R1.
034022 012700 034316 MOV #HELLO,R0 ;Load up the string to be output
034026 004767 163746 JSR PC,TYPSTR ;Call the string output utility routine.
034032 012601 MOV (SP)+,R1 ;Restore R1.
034034 012600 MOV (SP)+,R0 ;Restore R0.
034036 017400 000000 INT1: MOV @IPC(R4),R0 ;R0 ← next instruction
034042 002434 BLT INTER1 ;Instruction out of range
034044 020027 000070 CMP R0,#INSEND ;Is instruction too large?
034050 101031 BHI INTER1 ;Yes.
034052 062764 000002 000000 ADD #2,IPC(R4) ;Bump IPC
034060 004770 034374 JSR PC,@INTOPS(R0) ;Call the appropriate routine
034064 000400 BR INTCPL(R0) ;R0 should have an completion code. Branch accordingly.
034066 000421 INTCPL: BR INTSTS ;No error. Gather statistics.
HALERR INTMS2 ;Error.
034070 010046 MOV R0,-(SP) ;Save R0.
034072 010146 MOV R1,-(SP) ;Save R1.
034074 012700 020126 MOV #CRLFX,R0 ;Move to new line
034100 004767 163674 JSR PC,TYPSTR ;
034104 012700 034244 MOV #INTMS2,R0 ;Type out message
034110 004767 163664 JSR PC,TYPSTR ;
034114 012700 020131 MOV #RUGMES,R0 ;Type out RUGMES
034120 004767 163654 JSR PC,TYPSTR ;
034124 012601 MOV (SP)+,R1 ;Restore R1.
034126 012600 MOV (SP)+,R0 ;Restore R2.
034130 000003 BPT ;Breakpoint to DDT.
034132 000741 INTSTS: BR INT1 ;No statistics code written yet.
INTER1: HALERR INTMS1
034134 010046 MOV R0,-(SP) ;Save R0.
034136 010146 MOV R1,-(SP) ;Save R1.
034140 012700 020126 MOV #CRLFX,R0 ;Move to new line
034144 004767 163630 JSR PC,TYPSTR ;
034150 012700 034176 MOV #INTMS1,R0 ;Type out message
034154 004767 163620 JSR PC,TYPSTR ;
034160 012700 020131 MOV #RUGMES,R0 ;Type out RUGMES
034164 004767 163610 JSR PC,TYPSTR ;
034170 012601 MOV (SP)+,R1 ;Restore R1.
034172 012600 MOV (SP)+,R0 ;Restore R2.
034174 000003 BPT ;Breakpoint to DDT.
INTMS1: ASCIE /INTERPRETER INSTRUCTION OUT OF RANGE/
034176 111
034177 116
PALX 222 04/21/75 21:12:45 PAGE 68
INTERP PAL[HAL,HE] PAGE 3.1 Interpreter
034200 124
034201 105
034202 122
034203 120
034204 122
034205 105
034206 124
034207 105
034210 122
034211 040
034212 111
034213 116
034214 123
034215 124
034216 122
034217 125
034220 103
034221 124
034222 111
034223 117
034224 116
034225 040
034226 117
034227 125
034230 124
034231 040
034232 117
034233 106
034234 040
034235 122
034236 101
034237 116
034240 107
034241 105
034242 000
.ASCIZ /INTERPRETER INSTRUCTION OUT OF RANGE/
034244 .EVEN
INTMS2: ASCIE /INTERPRETED INSTRUCTION RETURNED FAILURE/
034244 111
034245 116
034246 124
034247 105
034250 122
034251 120
034252 122
034253 105
034254 124
034255 105
034256 104
PALX 222 04/21/75 21:12:45 PAGE 69
INTERP PAL[HAL,HE] PAGE 3.2 Interpreter
034257 040
034260 111
034261 116
034262 123
034263 124
034264 122
034265 125
034266 103
034267 124
034270 111
034271 117
034272 116
034273 040
034274 122
034275 105
034276 124
034277 125
034300 122
034301 116
034302 105
034303 104
034304 040
034305 106
034306 101
034307 111
034310 114
034311 125
034312 122
034313 105
034314 000
.ASCIZ /INTERPRETED INSTRUCTION RETURNED FAILURE/
034316 .EVEN
HELLO: ASCIE </
HELLO THERE. I AM A NEWBORN INTERPRETER.
/>
034316 015
034317 012 .ASCIZ /
034320 110
034321 105
034322 114
034323 114
034324 117
034325 040
034326 124
034327 110
034330 105
034331 122
034332 105
034333 056
PALX 222 04/21/75 21:12:45 PAGE 70
INTERP PAL[HAL,HE] PAGE 3.3 Interpreter
034334 040
034335 040
034336 111
034337 040
034340 101
034341 115
034342 040
034343 101
034344 040
034345 116
034346 105
034347 127
034350 102
034351 117
034352 122
034353 116
034354 040
034355 111
034356 116
034357 124
034360 105
034361 122
034362 120
034363 122
034364 105
034365 124
034366 105
034367 122
034370 056
034371 015
034372 012 HELLO THERE. I AM A NEWBORN INTERPRETER.
034373 000
/
034374 .EVEN
.MACRO MAKEOP CNAME, ANAME ;Compiler name, Address name
XX CNAME
ANAME
.ENDM
INTOPS:
000000 II == 0 ;Start of interpreter jump table
;Motion control
;PREPMOVE
;STARTMOVE
;Variable declaration
MAKEOP XVARIABLE,VARIABLE;o,a ;Put a ptr to a at offset o, current level.
XX XVARIABLE
PALX 222 04/21/75 21:12:45 PAGE 71
INTERP PAL[HAL,HE] PAGE 3.4 Interpreter
.IFDF XVARIABLE
.IF1
.ERROR You are using XVARIABLE in two ways!!!
.ENDC
.ENDC
000000 XVARIABLE == II
000002 II == II+2
034374 034706 VARIABLE
;Stack operations
MAKEOP XGTVAL,GTVAL;a ;Push value of arg (level-offset pair).
XX XGTVAL
.IFDF XGTVAL
.IF1
.ERROR You are using XGTVAL in two ways!!!
.ENDC
.ENDC
000002 XGTVAL == II
000004 II == II+2
034376 034742 GTVAL
MAKEOP XCHNGE,CHNGE;a ;Pop value into arg (level-offset pair).
XX XCHNGE
.IFDF XCHNGE
.IF1
.ERROR You are using XCHNGE in two ways!!!
.ENDC
.ENDC
000004 XCHNGE == II
000006 II == II+2
034400 035006 CHNGE
MAKEOP XPUSH, PUSH ;a ;Push arg directly (as a ptr) onto stack. For cnstnts.
XX XPUSH
.IFDF XPUSH
.IF1
.ERROR You are using XPUSH in two ways!!!
.ENDC
.ENDC
000006 XPUSH == II
000010 II == II+2
034402 035054 PUSH
MAKEOP XPOP, POP ;Pop stack.
XX XPOP
.IFDF XPOP
.IF1
.ERROR You are using XPOP in two ways!!!
.ENDC
.ENDC
000010 XPOP == II
000012 II == II+2
PALX 222 04/21/75 21:12:45 PAGE 72
INTERP PAL[HAL,HE] PAGE 3.5 Interpreter
034404 035046 POP
MAKEOP XCOPY, COPY ;n ;Copy n'th down to top of stack.
XX XCOPY
.IFDF XCOPY
.IF1
.ERROR You are using XCOPY in two ways!!!
.ENDC
.ENDC
000012 XCOPY == II
000014 II == II+2
034406 035072 COPY
MAKEOP XREPLAC,REPLAC;n;Replace n'th down with top (which pop)
XX XREPLAC
.IFDF XREPLAC
.IF1
.ERROR You are using XREPLAC in two ways!!!
.ENDC
.ENDC
000014 XREPLAC == II
000016 II == II+2
034410 035114 REPLAC
MAKEOP XFLUSH,FLUSH ;Flush the entire stack.
XX XFLUSH
.IFDF XFLUSH
.IF1
.ERROR You are using XFLUSH in two ways!!!
.ENDC
.ENDC
000016 XFLUSH == II
000020 II == II+2
034412 035136 FLUSH
;Flow of control
MAKEOP XJUMP, JUMP ;a ;Jump to address
XX XJUMP
.IFDF XJUMP
.IF1
.ERROR You are using XJUMP in two ways!!!
.ENDC
.ENDC
000020 XJUMP == II
000022 II == II+2
034414 036036 JUMP
MAKEOP XJUMPZ,JUMPZ;a ;Jump to address only if top zero (which pop)
XX XJUMPZ
.IFDF XJUMPZ
.IF1
.ERROR You are using XJUMPZ in two ways!!!
.ENDC
PALX 222 04/21/75 21:12:45 PAGE 73
INTERP PAL[HAL,HE] PAGE 3.6 Interpreter
.ENDC
000022 XJUMPZ == II
000024 II == II+2
034416 036050 JUMPZ
MAKEOP XTERMINATE,TERMINATE ;Terminate this interpreter
XX XTERMINATE
.IFDF XTERMINATE
.IF1
.ERROR You are using XTERMINATE in two ways!!!
.ENDC
.ENDC
000024 XTERMINATE == II
000026 II == II+2
034420 036100 TERMINATE
MAKEOP XPROC, PROC;d,al;Call a procedure at d, with arg list al.
XX XPROC
.IFDF XPROC
.IF1
.ERROR You are using XPROC in two ways!!!
.ENDC
.ENDC
000026 XPROC == II
000030 II == II+2
034422 035146 PROC
MAKEOP XRETURN,RETURN ;Return from procedure
XX XRETURN
.IFDF XRETURN
.IF1
.ERROR You are using XRETURN in two ways!!!
.ENDC
.ENDC
000030 XRETURN == II
000032 II == II+2
034424 035354 RETURN
MAKEOP XSPROUT,SPROUT;d;Sprout an interpreter at d.
XX XSPROUT
.IFDF XSPROUT
.IF1
.ERROR You are using XSPROUT in two ways!!!
.ENDC
.ENDC
000032 XSPROUT == II
000034 II == II+2
034426 035454 SPROUT
MAKEOP XFORCHK,FORCHK;d;Do a FOR-loop check, and fail to location d.
XX XFORCHK
.IFDF XFORCHK
.IF1
.ERROR You are using XFORCHK in two ways!!!
PALX 222 04/21/75 21:12:45 PAGE 74
INTERP PAL[HAL,HE] PAGE 3.7 Interpreter
.ENDC
.ENDC
000034 XFORCHK == II
000036 II == II+2
034430 035412 FORCHK
;Arithmetic
MAKEOP XSADD, SADD ;S+S: Add top two elts, pop, pop, push answer
XX XSADD
.IFDF XSADD
.IF1
.ERROR You are using XSADD in two ways!!!
.ENDC
.ENDC
000036 XSADD == II
000040 II == II+2
034432 036130 SADD
MAKEOP XSSUB, SSUB ;S-S: Sub top two elts, pop, pop, push answer
XX XSSUB
.IFDF XSSUB
.IF1
.ERROR You are using XSSUB in two ways!!!
.ENDC
.ENDC
000040 XSSUB == II
000042 II == II+2
034434 036146 SSUB
MAKEOP XSMUL, SMUL ;S*S: Mul top two elts, pop, pop, push answer
XX XSMUL
.IFDF XSMUL
.IF1
.ERROR You are using XSMUL in two ways!!!
.ENDC
.ENDC
000042 XSMUL == II
000044 II == II+2
034436 036170 SMUL
MAKEOP XSDIV, SDIV ;S/S: Div top two elts, pop, pop, push answer
XX XSDIV
.IFDF XSDIV
.IF1
.ERROR You are using XSDIV in two ways!!!
.ENDC
.ENDC
000044 XSDIV == II
000046 II == II+2
034440 036206 SDIV
MAKEOP XSNEG, SNEG ;-S: Negate top elt, pop, push answer
XX XSNEG
PALX 222 04/21/75 21:12:45 PAGE 75
INTERP PAL[HAL,HE] PAGE 3.8 Interpreter
.IFDF XSNEG
.IF1
.ERROR You are using XSNEG in two ways!!!
.ENDC
.ENDC
000046 XSNEG == II
000050 II == II+2
034442 036226 SNEG
MAKEOP XVMAG, VMAG ;Scalar ← norm of vector
XX XVMAG
.IFDF XVMAG
.IF1
.ERROR You are using XVMAG in two ways!!!
.ENDC
.ENDC
000050 XVMAG == II
000052 II == II+2
034444 036350 VMAG
MAKEOP XSVMUL,SVMUL ;Vector ← scalar * vector
XX XSVMUL
.IFDF XSVMUL
.IF1
.ERROR You are using XSVMUL in two ways!!!
.ENDC
.ENDC
000052 XSVMUL == II
000054 II == II+2
034446 036642 SVMUL
MAKEOP XVDOT, VDOT ;S ← vector dot vector
XX XVDOT
.IFDF XVDOT
.IF1
.ERROR You are using XVDOT in two ways!!!
.ENDC
.ENDC
000054 XVDOT == II
000056 II == II+2
034450 036244 VDOT
MAKEOP XPVDOT,PVDOT ;S ← vector dot vector
XX XPVDOT
.IFDF XPVDOT
.IF1
.ERROR You are using XPVDOT in two ways!!!
.ENDC
.ENDC
000056 XPVDOT == II
000060 II == II+2
034452 036310 PVDOT
MAKEOP XVMAKE,VMAKE ;V ← vector(scalar,scalar,scalar)
PALX 222 04/21/75 21:12:45 PAGE 76
INTERP PAL[HAL,HE] PAGE 3.9 Interpreter
XX XVMAKE
.IFDF XVMAKE
.IF1
.ERROR You are using XVMAKE in two ways!!!
.ENDC
.ENDC
000060 XVMAKE == II
000062 II == II+2
034454 036702 VMAKE
MAKEOP XVADD, VADD ;V ← vector + vector
XX XVADD
.IFDF XVADD
.IF1
.ERROR You are using XVADD in two ways!!!
.ENDC
.ENDC
000062 XVADD == II
000064 II == II+2
034456 036734 VADD
;UNITV remove ;Vector ← vector / its norm
;CROSV remove ;Vector ← vector cross vector
MAKEOP XTVMUL,TVMUL ;Vector ← trans * vector
XX XTVMUL
.IFDF XTVMUL
.IF1
.ERROR You are using XTVMUL in two ways!!!
.ENDC
.ENDC
000064 XTVMUL == II
000066 II == II+2
034460 037000 TVMUL
;FTOF
MAKEOP XTMAKE,TMAKE ;Trans ← trans(rot,vector)
XX XTMAKE
.IFDF XTMAKE
.IF1
.ERROR You are using XTMAKE in two ways!!!
.ENDC
.ENDC
000066 XTMAKE == II
000070 II == II+2
034462 037114 TMAKE
;TTMUL
;TINV
000070 INSEND = II ;Marks the end of the instructions
PALX 222 04/21/75 21:12:45 PAGE 77
INTERP PAL[HAL,HE] PAGE 4 Interpreter
; GETARG, GETSCA, GETVEC, GETTRN, GETVAL
GETARG:
;Arguments:
; R0=variable name: low byte is lexical level, high byte is offset.
; R4=pointer to interpreter status block.
;Result:
; R0← pointer to address of desired variable.
; R1 clobbered.
;This routine returns in R0 a pointer to the location in the current
; environment (or, if necessary, more global environment) which
; points to the variable which is named in R0.
034464 010246 MOV R2,-(SP) ;Save R2
034466 110001 MOVB R0,R1 ;R1 ← Lexical level desired
034470 105000 CLRB R0 ;
034472 000300 SWAB R0 ;R0 ← Offset
034474 016402 000006 MOV ENV(R4),R2 ;R2 ← LOC[local environment]
034500 166401 000010 SUB LEV(R4),R1 ;R1 ← Difference in levels: desired-got
034504 001405 BEQ GTRG1 ;Diff=0; can use R2 as pointer at right base.
034506 101007 BHI GTERR ;If diff>0, then value inaccessible.
034510 016202 000000 GTRG2: MOV SLINK(R2),R2;Must go up a level. R2 ← LOC[more global environment]
034514 005201 INC R1 ;R1 ← New difference in levels
034516 001374 BNE GTRG2 ;If not yet good, then move up another level
034520 060200 GTRG1: ADD R2,R0 ;R0 ← environment + offset = location of desired pointer
034522 012602 MOV (SP)+,R2 ;Restore R2.
034524 000207 RTS PC ;Done.
GTERR: HALERR GTMS1
034526 010046 MOV R0,-(SP) ;Save R0.
034530 010146 MOV R1,-(SP) ;Save R1.
034532 012700 020126 MOV #CRLFX,R0 ;Move to new line
034536 004767 163236 JSR PC,TYPSTR ;
034542 012700 034570 MOV #GTMS1,R0 ;Type out message
034546 004767 163226 JSR PC,TYPSTR ;
034552 012700 020131 MOV #RUGMES,R0 ;Type out RUGMES
034556 004767 163216 JSR PC,TYPSTR ;
034562 012601 MOV (SP)+,R1 ;Restore R1.
034564 012600 MOV (SP)+,R0 ;Restore R2.
034566 000003 BPT ;Breakpoint to DDT.
GTMS1: ASCIE /ATTEMPT TO ACCESS UNAVAILABLE VARIABLE/
034570 101
034571 124
034572 124
034573 105
034574 115
034575 120
034576 124
034577 040
034600 124
034601 117
PALX 222 04/21/75 21:12:45 PAGE 78
INTERP PAL[HAL,HE] PAGE 4.1 Interpreter
034602 040
034603 101
034604 103
034605 103
034606 105
034607 123
034610 123
034611 040
034612 125
034613 116
034614 101
034615 126
034616 101
034617 111
034620 114
034621 101
034622 102
034623 114
034624 105
034625 040
034626 126
034627 101
034630 122
034631 111
034632 101
034633 102
034634 114
034635 105
034636 000
.ASCIZ /ATTEMPT TO ACCESS UNAVAILABLE VARIABLE/
034640 .EVEN
GETSCA: ;Gets place for a scalar result, and places a pointer on
;the interpreter stack. Location is returned in R0.
;Simple procedure.
034640 012700 000002 MOV #2,R0 ;Number of words needed
034644 004767 176254 JSR PC,GTFREE ;R0 ← LOC[new block]
; MOV #RES,R0 ;Temporary kludge. Delete this line in final runs.
034650 010043 MOV R0,-(R3) ;Push new value cell pointer on interpreter stack.
034652 000207 RTS PC ;Done
GETVEC: ;Gets place for a vector result, and places a pointer on
;the interpreter stack. Location is returned in R0.
;Simple procedure.
034654 012700 000010 MOV #10,R0 ;Number of words needed
034660 004767 176240 JSR PC,GTFREE ;R0 ← LOC[new block]
; MOV #RES,R0 ;Temporary kludge. Delete this line in final runs.
034664 010043 MOV R0,-(R3) ;Push new value cell pointer on interpreter stack.
034666 000207 RTS PC ;Done
PALX 222 04/21/75 21:12:45 PAGE 79
INTERP PAL[HAL,HE] PAGE 4.2 Interpreter
GETTRN: ;Gets place for a trans result, and places a pointer on
;the interpreter stack. Location is returned in R0.
;Simple procedure.
034670 012700 000040 MOV #40,R0 ;Number of words needed
034674 004767 176224 JSR PC,GTFREE ;R0 ← LOC[new block]
; MOV #RES,R0 ;Temporary kludge. Delete this line in final runs.
034700 010043 MOV R0,-(R3) ;Push new value cell pointer on interpreter stack.
034702 000207 RTS PC ;Done
GETVAL:
;Should access graph structure pointed to by R0, return pointer to
;valid value cell in R0. But for the time being, just returns. This
;works when not using graph structure.
034704 000205 RTS RF ;Done
PALX 222 04/21/75 21:12:45 PAGE 80
INTERP PAL[HAL,HE] PAGE 5 Interpreter
;Variable declaration: VARIABLE
VARIABLE:
;Two args: the offset and the address. Puts a pointer in the current
;environment to that variable, giving it that offset.
034706 016400 000006 MOV ENV(R4),R0 ;R0 ← LOC[environment]
034712 067400 000000 ADD @IPC(R4),R0 ;R0 ← LOC[pointer to variable]
034716 062764 000002 000000 ADD #2,IPC(R4) ;Bump IPC
034724 017410 000000 MOV @IPC(R4),(R0);Put the pointer in its place.
034730 062764 000002 000000 ADD #2,IPC(R4) ;Bump IPC
034736 005000 CLR R0 ;Clear condition code.
034740 000207 RTS PC ;Done
PALX 222 04/21/75 21:12:45 PAGE 81
INTERP PAL[HAL,HE] PAGE 6 Interpreter
;Stack ops: GTVAL, CHNGE, PUSH, POP, COPY, REPLACE, FLUSH
034742 017400 000000 GTVAL: MOV @IPC(R4),R0 ;Pick up level-offset name of argument
034746 062764 000002 000000 ADD #2,IPC(R4) ;Bump IPC
034754 004767 177504 JSR PC,GETARG ;R0 ← LOC[LOC[desired graph node]]
034760 011000 MOV (R0),R0 ;R0 ← LOC[desired graph node]
CALL GETVAL,<R0>;R0 ← value
034762 010546 MOV RF,-(SP) ;Save RF
006400 NNNN == 6400 ;This is a MARK 0 instruction
.IFNB R0
.IRP II,<R0>
MOV II,-(SP);Push an argument
NNNN == NNNN+1 ;Make NNNN the next MARK instruction.
.ENDM
034764 010046 MOV R0,-(SP);Push an argument
006401 NNNN == NNNN+1 ;Make NNNN the next MARK instruction.
.ENDC
034766 012746 006401 MOV #NNNN,-(SP) ;Push the mark instruction.
034772 010605 MOV SP,RF ;Set up the display in RF.
034774 004767 177704 JSR PC,GETVAL ;Call the routine
035000 010043 MOV R0,-(R3) ;Push value on interpreter stack.
035002 005000 CLR R0 ;Clear condition code.
035004 000207 RTS PC ;Done
035006 017400 000000 CHNGE: MOV @IPC(R4),R0 ;Pick up level-offset name of argument
035012 062764 000002 000000 ADD #2,IPC(R4) ;Bump IPC
035020 004767 177440 JSR PC,GETARG ;R0 ← LOC[LOC[Desired graph node]]
035024 011000 MOV (R0),R0 ;R0 ← LOC[Desired graph node]
CALL CHANGE,<R0,(R3)>
035026 010546 MOV RF,-(SP) ;Save RF
006400 NNNN == 6400 ;This is a MARK 0 instruction
.IFNB R0,(R3)
.IRP II,<R0,(R3)>
MOV II,-(SP);Push an argument
NNNN == NNNN+1 ;Make NNNN the next MARK instruction.
.ENDM
035030 010046 MOV R0,-(SP);Push an argument
006401 NNNN == NNNN+1 ;Make NNNN the next MARK instruction.
035032 011346 MOV (R3),-(SP);Push an argument
006402 NNNN == NNNN+1 ;Make NNNN the next MARK instruction.
.ENDC
035034 012746 006402 MOV #NNNN,-(SP) ;Push the mark instruction.
035040 010605 MOV SP,RF ;Set up the display in RF.
CHNGE+34 35042 6 17 CHANGE UNDEFINED
035042 004767 142732 JSR PC,CHANGE ;Call the routine
035046 005723 POP: TST (R3)+ ;Pop stack
035050 005000 CLR R0 ;Clear condition code.
035052 000207 RTS PC ;Done
PALX 222 04/21/75 21:12:45 PAGE 82
INTERP PAL[HAL,HE] PAGE 6.1 Interpreter
035054 017443 000000 PUSH: MOV @IPC(R4),-(R3);Put argument directly on stack
035060 062764 000002 000000 ADD #2,IPC(R4) ;Bump IPC
035066 005000 CLR R0 ;Clear condition code.
035070 000207 RTS PC ;Done
035072 017400 000000 COPY: MOV @IPC(R4),R0 ;Pick up argument.
035076 062764 000002 000000 ADD #2,IPC(R4) ;Bump IPC
035104 060300 ADD R3,R0 ;R0 ← LOC[stack element to be copied to top]
035106 011043 MOV (R0),-(R3) ;Copy it onto top of stack.
035110 005000 CLR R0 ;Clear condition code.
035112 000207 RTS PC ;Done
035114 017400 000000 REPLAC: MOV @IPC(R4),R0 ;Pick up argument.
035120 062764 000002 000000 ADD #2,IPC(R4) ;Bump IPC
035126 060300 ADD R3,R0 ;R0 ← LOC[stack element to be copied into]
035130 014310 MOV -(R3),(R0) ;Copy top of stack into it.
035132 005000 CLR R0 ;Clear condition code.
035134 000207 RTS PC ;Done
035136 016403 000002 FLUSH: MOV STKBAS(R4),R3;Reset the stack base.
035142 005000 CLR R0 ;Clear condition code.
035144 000207 RTS PC ;Done
PALX 222 04/21/75 21:12:45 PAGE 83
INTERP PAL[HAL,HE] PAGE 7 Interpreter
;Flow-of-control: PROC, RETURN
PROC:
;Procedure call. Arguments:
; Destination.
; List of variables which are to be inserted in appropriate
; locations in the local storage of procedure. These are
; in the format variable (ie level-offset pair), new offset
; (right justified in the second word).
; There is a zero word to finish these.
;At the destination address can be found:
000000 II == 0
XX FSLGTH ;Number of words to get from free storage
.IFDF FSLGTH
.IF1
.ERROR You are using FSLGTH in two ways!!!
.ENDC
.ENDC
000000 FSLGTH == II
000002 II == II+2
;for local variable pointers
XX PLEV ;Lexical level of procedure
.IFDF PLEV
.IF1
.ERROR You are using PLEV in two ways!!!
.ENDC
.ENDC
000002 PLEV == II
000004 II == II+2
000004 DSLGTH == II ;Number of words before code starts
;Value parameters should have first been copied first into local temps
; (which have been arranged by the compiler), and then the temps are
; passed by reference. Eventual problem: to know which variables to
; really kill as the procedure is exited.
035146 010246 MOV R2,-(SP) ;Save R2
035150 017402 000000 MOV @IPC(R4),R2 ;R2 ← LOC[destination]
035154 062764 000002 000000 ADD #2,IPC(R4) ;Bump IPC
035162 016200 000000 MOV FSLGTH(R2),R0 ;R0 ← Number of words to get.
035166 004767 175732 JSR PC,GTFREE ;R0 ← LOC[block with that number of words]
;initialize pointer to lexical level:
035172 016201 000002 MOV PLEV(R2),R1 ;R1 ← Lexical level of procedure
035176 016402 000006 MOV ENV(R4),R2 ;R2 ← LOC[current environment]
035202 166401 000010 SUB LEV(R4),R1 ;R1 ← Difference in levels: desired-got
035206 001404 BEQ PRC1 ;Diff=0; can use R2 as pointer at right environment.
035210 016202 000000 PRC2: MOV SLINK(R2),R2;No, must go up a level. R2 ← LOC[base of upper area]
035214 005201 INC R1 ;R1 ← New difference in levels
035216 001374 BNE PRC2 ;If not yet good, then move up another level
PALX 222 04/21/75 21:12:45 PAGE 84
INTERP PAL[HAL,HE] PAGE 7.1 Interpreter
035220 010260 000000 PRC1: MOV R2,SLINK(R0);SLINK[new environment] ← correct global environment
;Put copies of local variables in new area
035224 010046 MOV R0,-(SP) ;Stack LOC[new environment]
035226 017400 000000 MOV @IPC(R4),R0 ;R0 ← level-offset pair for an argument
035232 001417 BEQ PRC3 ;If there are no more, go to next phase
035234 062764 000002 000000 PRC4: ADD #2,IPC(R4) ;Else bump IPC
035242 004767 177216 JSR PC,GETARG ;R0 ← LOC[LOC[graph node]]
035246 017401 000000 MOV @IPC(R4),R1 ;R1 ← offset in new block
035252 062764 000002 000000 ADD #2,IPC(R4) ;Bump IPC
035260 061601 ADD (SP),R1 ;R1 ← LOC[place in new environment to put pointer]
035262 011011 MOV (R0),(R1) ;new environment gets pointer to LOC[argument graph node]
035264 017400 000000 MOV @IPC(R4),R0 ;R0 ← level-offset pair for an argument
035270 001361 BNE PRC4 ;If there are more, go back and treat them
035272 062764 000002 000000 PRC3: ADD #2,IPC(R4) ;Bump IPC one last time
;Save the old context in the new area
035300 012601 MOV (SP)+,R1 ;R1 ← LOC[new environment]
035302 016461 000010 000002 MOV LEV(R4),OLEV(R1) ;Store the old level
035310 016461 000006 000004 MOV ENV(R4),OENV(R1) ;Store the old environment location
035316 016461 000000 000006 MOV IPC(R4),OIPC(R1) ;Store the return address
;Set up the new context for procedure
035324 016264 000002 000010 MOV PLEV(R2),LEV(R4) ;New lexical level
035332 010164 000006 MOV R1,ENV(R4) ;New environment location
035336 062702 000004 ADD #DSLGTH,R2 ;R2 ← Place where execution should begin
035342 010264 000000 MOV R2,IPC(R4) ;New program counter
035346 012602 MOV (SP)+,R2 ;Restore R2
035350 005000 CLR R0 ;Clear condition code.
035352 000207 RTS PC ;Done
RETURN:
;Returns from a procedure call to calling program. Since variables are
;passed by reference, it is not necessary to do any copying of values.
;All that is needed is to restore the context of the caller and to
;discard the display.
035354 016400 000006 MOV ENV(R4),R0 ;R0 ← LOC[current environment]
035360 016064 000002 000010 MOV OLEV(R0),LEV(R4) ;Restore the old lexical level
035366 016064 000004 000006 MOV OENV(R0),ENV(R4) ;Restore the old environment
035374 016064 000006 000000 MOV OIPC(R0),IPC(R4) ;Restore the IPC
035402 004767 176064 JSR PC,RLFREE ;Release storage of old display
035406 005000 CLR R0 ;Clear condition code.
035410 000207 RTS PC ;Done
PALX 222 04/21/75 21:12:45 PAGE 85
INTERP PAL[HAL,HE] PAGE 8 Interpreter
; FORCHK, SPROUT, JUMP, JUMPZ, TERMINATE
FORCHK:
;Assume that the stack has, from surface in, the increment, the
; final value, and the control variable's value, all of which are
; scalar values. If (FINAL-CONVAR)*(INCREMENT) ≥ 0 then this is a
; no-op; otherwise, jump to the destination.
;Arguments: destination.
035412 172473 000002 LDF @2(R3),AC0 ;AC0 ← final value
035416 173073 000004 SUBF @4(R3),AC0 ;AC0 ← final - current
035422 171073 000000 MULF @(R3),AC0 ;AC0 ← (final - current)*increment
035426 017400 000000 MOV @IPC(R4),R0 ;R0 ← destination
035432 062764 000002 000000 ADD #2,IPC(R4) ;Bump IPC
035440 170000 CFCC ;
035442 002002 BGE FOR1 ;Shall this be a no-op?
035444 010064 000000 MOV R0,IPC(R4) ;No; set new IPC.
035450 005000 FOR1: CLR R0 ;
035452 000207 RTS PC ;Done
SPROUT:
COMMENT ⊗
Arguments: One address in pseudo-code for each of the several forks
starting up, followed by a 0 word. This is to be used only for
cobegins, not for servos. Each new interpreter is given an
interpreter status block and is then scheduled. As each terminates,
it signals its defining event. Since each of these has the same
event, the current interpreter need only wait until they all happen.
⊗
000040 PDBSTA == 40 ;Process Descriptor Block Status Word
000060 PDBR0 == 60 ;Where R0 is saved
000062 PDBR1 == 62 ;Where R1 is saved
000064 PDBR2 == 64 ;Where R2 is saved
000066 PDBR3 == 66 ;Where R3 is saved
000070 PDBR4 == 70 ;Where R4 is saved
000072 PDBR5 == 72 ;Where R5 is saved
000074 PDBSP == 74 ;Where SP is saved
000076 PDBPC == 76 ;Where PC is saved
000104 PDBSSV == 104 ;Process Descriptor Block Stack Save Length Word
035454 010246 MOV R2,-(SP) ;Save R2.
035456 010346 MOV R3,-(SP) ;Save R3. Caution: cannot use interpreter stack now.
035460 005003 CLR R3 ;R3 is the count of how many inferiors to spawn.
EVMAK ;-(SP) ← Event identifier for communication with infs.
035462 104002 104002
035464 017402 000000 SPR2: MOV @IPC(R4),R2 ;R2 ← next argument
035470 001505 BEQ SPR1 ;If zero, then we have spawned all the inferiors.
035472 062764 000002 000000 ADD #2,IPC(R4) ;Bump IPC
PALX 222 04/21/75 21:12:45 PAGE 86
INTERP PAL[HAL,HE] PAGE 8.1 Interpreter
035500 005203 INC R3 ;Yes. Count it.
035502 012700 000010 MOV #ISBS,R0 ;R0 ← Size (in words) of an interpreter status block
035506 004767 175412 JSR PC,GTFREE ;R0 ← LOC[new interpreter status block]
035512 010260 000000 MOV R2,IPC(R0) ;new IPC ← jump address
035516 016460 000006 000006 MOV ENV(R4),ENV(R0) ;new ENV ← old ENV
035524 016460 000010 000010 MOV LEV(R4),LEV(R0) ;new LEV ← old LEV
035532 011660 000016 MOV (SP),EVT(R0);new EVT ← event just created.
035536 010046 MOV R0,-(SP) ;Save LOC[new interpreter status block]
035540 012700 000020 MOV #INSTSZ,R0 ;R0 ← Size needed for an interpreter stack
035544 004767 175354 JSR PC,GTFREE ;R0 ← LOC[new interpreter stack]
035550 012601 MOV (SP)+,R1 ;R1 ← LOC[new interpreter status block]
035552 010061 000002 MOV R0,STKBAS(R1) ;Store away new stack base
035556 062700 000040 ADD #2*INSTSZ,R0 ;R0 ← LOC[top of new stack] (INSTSZ is in bytes)
035562 010146 MOV R1,-(SP) ;Save R1
035564 010046 MOV R0,-(SP) ;Save R0
035566 012700 000210 MOV #210,R0 ;Room for process descriptor
035572 004767 175326 JSR PC,GTFREE ;R0 ← LOC[new process descriptor]
035576 012760 100100 000040 MOV #UFPUSE+UGPSAV,PDBSTA(R0);Use floating point, use saved registers.
035604 012760 000100 000104 MOV #100,PDBSSV(R0) ;Length of stack to be saved.
035612 010260 000064 MOV R2,PDBR2(R0) ;Transfer register 2
035616 012601 MOV (SP)+,R1 ;R1 ← LOC[new interpreter stack top]
035620 010160 000066 MOV R1,PDBR3(R0) ;Store away new interp stack pointer (reg 3)
035624 011660 000054 MOV (SP),PCB+PDBSTA(R0) ;Set PDB for new interp status block
035630 012660 000070 MOV (SP)+,PDBR4(R0);Store away new interp status block ptr. (reg 4)
035634 010560 000072 MOV R5,PDBR5(R0) ;Store away reg 5
035640 010601 MOV SP,R1 ;
035642 005721 TST (R1)+ ;
035644 010160 000074 MOV R1,PDBSP(R0) ;Store away the new stack pointer (reg 6)
035650 012760 034016 000076 MOV #INTERP,PDBPC(R0);Store away the new PC
035656 062700 000040 ADD #PDBSTA,R0 ;R0 ← middle of Process Descriptor Block
SCHEDU R0,#INTERP,#0,#2;Cause the new process to be started, suspended
035662 012746 000002 MOV #2,-(SP)
035666 012746 000000 MOV #0,-(SP)
035672 012746 034016 MOV #INTERP,-(SP)
035676 010046 MOV R0,-(SP)
035700 104007 104007
035702 000670 BR SPR2 ;Go handle the next inferior.
035704 062764 000002 000000 SPR1: ADD #2,IPC(R4) ;Bump IPC
035712 005303 SPR4: DEC R3 ;Another wait to be done?
035714 103424 BLO SPR3 ;No, we are finished.
EVWAIT (SP) ;Wait for an inferior to come back.
035716 011646 MOV (SP),-(SP)
035720 104004 104004
035722 103373 BCC SPR4 ;If all well, wait for the next one.
HALERR SPRMES ;The event was killed!
035724 010046 MOV R0,-(SP) ;Save R0.
035726 010146 MOV R1,-(SP) ;Save R1.
035730 012700 020126 MOV #CRLFX,R0 ;Move to new line
035734 004767 162040 JSR PC,TYPSTR ;
PALX 222 04/21/75 21:12:45 PAGE 87
INTERP PAL[HAL,HE] PAGE 8.2 Interpreter
035740 012700 036002 MOV #SPRMES,R0 ;Type out message
035744 004767 162030 JSR PC,TYPSTR ;
035750 012700 020131 MOV #RUGMES,R0 ;Type out RUGMES
035754 004767 162020 JSR PC,TYPSTR ;
035760 012601 MOV (SP)+,R1 ;Restore R1.
035762 012600 MOV (SP)+,R0 ;Restore R2.
035764 000003 BPT ;Breakpoint to DDT.
SPR3: EVKIL (SP)+ ;Kill the event now, remove from stack
035766 012646 MOV (SP)+,-(SP)
035770 104003 104003
035772 012603 MOV (SP)+,R3 ;Restore R3
035774 012602 MOV (SP)+,R2 ;Restore R2
035776 005000 CLR R0 ;Clear condition code.
036000 000207 RTS PC ;Done
SPRMES: ASCIE /BAD RETURN FROM INTERPRETER/
036002 102
036003 101
036004 104
036005 040
036006 122
036007 105
036010 124
036011 125
036012 122
036013 116
036014 040
036015 106
036016 122
036017 117
036020 115
036021 040
036022 111
036023 116
036024 124
036025 105
036026 122
036027 120
036030 122
036031 105
036032 124
036033 105
036034 122
036035 000
.ASCIZ /BAD RETURN FROM INTERPRETER/
036036 .EVEN
JUMP:
;Takes one argument: the new address.
036036 017464 000000 000000 MOV @IPC(R4),IPC(R4)
PALX 222 04/21/75 21:12:45 PAGE 88
INTERP PAL[HAL,HE] PAGE 8.3 Interpreter
036044 005000 CLR R0 ;Clear condition code.
036046 000207 RTS PC ;Done
JUMPZ:
;Takes one argument: the new address. Jumps if top of stack is zero.
036050 012300 MOV (R3)+,R0 ;R0 ← LOC[arg]
036052 172410 LDF (R0),AC0 ;AC0 ← arg
036054 170000 CFCC ;
036056 001003 BNE JMPZ1 ;Zero?
036060 017464 000000 000000 MOV @IPC(R4),IPC(R4) ;Yes
036066 062764 000002 000000 JMPZ1: ADD #2,IPC(R4) ;Bump IPC
036074 005000 CLR R0 ;Clear condition code.
036076 000207 RTS PC ;Done
TERMINATE:
;End this interpreter. Currently does not attempt to reclaim storage.
EVSIG EVT(R4) ;Announce that we are about to disappear.
036100 016446 000016 MOV EVT(R4),-(SP)
036104 104005 104005
036106 016400 000002 MOV STKBAS(R4),R0 ;Reclaim interpreter stack
036112 004767 175354 JSR PC,RLFREE ;
036116 016400 000014 MOV PCB(R4),R0 ;Reclaim process control block (may be dangerous)
036122 004767 175344 JSR PC,RLFREE ;
DISMIS ;Go away
036126 104000 104000
PALX 222 04/21/75 21:12:45 PAGE 89
INTERP PAL[HAL,HE] PAGE 9 Interpreter
;return scalars: SADD, SSUB, SMUL, SDIV, SNEG, VDOT, PVDOT, VMAG
;All timings are averages of 1000 runs. They take into account
;the cost of the RTS but not the JSR. It is assumed that GETSCA
;and GETVEC take no time.
;30 microseconds
SADD: ;Scalar ← Scalar + Scalar
036130 172433 LDF @(R3)+,AC0 ;AC0 ← arg 2
036132 172033 ADDF @(R3)+,AC0 ;AC0 ← arg2 + arg1
036134 004767 176500 JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
036140 174010 STF AC0,(R0) ;Store result
036142 005000 CLR R0 ;Clear condition code.
036144 000207 RTS PC ;Done
SSUB: ;Scalar ← Scalar - Scalar
036146 172473 000002 LDF @2(R3),AC0 ;AC0 ← arg 1
036152 173033 SUBF @(R3)+,AC0 ;AC0 ← arg1 - arg2
036154 005723 TST (R3)+ ;Move past first argument
036156 004767 176456 JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
036162 174010 STF AC0,(R0) ;Store result
036164 005000 CLR R0 ;Clear condition code.
036166 000207 RTS PC ;Done
;30 microseconds
SMUL: ;Scalar ← scalar * scalar
036170 172433 LDF @(R3)+,AC0 ;AC0 ← arg 2
036172 171033 MULF @(R3)+,AC0 ;AC0 ← arg2 * arg1
036174 004767 176440 JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
036200 174010 STF AC0,(R0) ;Store result
036202 005000 CLR R0 ;Clear condition code.
036204 000207 RTS PC ;Done
;33 microseconds
SDIV: ;Scalar ← Scalar / Scalar
036206 172533 LDF @(R3)+,AC1 ;AC1 ← arg 2
036210 172433 LDF @(R3)+,AC0 ;AC0 ← arg 1
036212 174401 DIVF AC1,AC0 ;AC0 ← arg1 / arg2
036214 004767 176420 JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
036220 174010 STF AC0,(R0) ;Store result
036222 005000 CLR R0 ;Clear condition code.
036224 000207 RTS PC ;Done
;26 microseconds
SNEG: ;Scalar ← -Scalar
036226 172433 LDF @(R3)+,AC0 ;AC0 ← arg
036230 170700 NEGF AC0 ;AC0 ← -arg
036232 004767 176402 JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
036236 174010 STF AC0,(R0) ;Store result
PALX 222 04/21/75 21:12:45 PAGE 90
INTERP PAL[HAL,HE] PAGE 9.1 Interpreter
036240 005000 CLR R0 ;Clear condition code.
036242 000207 RTS PC ;Done
;96 -- 116 microseconds
VDOT: ;Scalar ← Vector dot Vector
;S ← (X1X2 + Y1Y2 + Z1Z2) / W1W2
036244 010246 MOV R2,-(SP) ;Save R2.
036246 012301 MOV (R3)+,R1 ;R1 ← LOC[arg 2]
036250 012300 MOV (R3)+,R0 ;R0 ← LOC[arg 1]
036252 170400 CLRF AC0 ;AC0 ← 0. Running total
036254 012702 000003 MOV #3,R2 ;R2 ← 3: Length of vector
036260 172520 VDV1: LDF (R0)+,AC1 ;Form sum of products of first 3 terms
036262 171121 MULF (R1)+,AC1 ;
036264 172001 ADDF AC1,AC0 ;
036266 077204 SOB R2,VDV1 ;Loop until all 3 fields done.
036270 174410 DIVF (R0),AC0 ;Divide by W1
036272 174411 DIVF (R1),AC0 ;Divide by W2. AC0 now has answer.
036274 004767 176340 JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
036300 174010 STF AC0,(R0) ;Store result
036302 012602 MOV (SP)+,R2 ;Restore R2
036304 005000 CLR R0 ;Clear condition code.
036306 000207 RTS PC ;Done
;103 -- 116 microseconds
PVDOT: ;Scalar ← Plane dot Vector
;S ← X1X2 + Y1Y2 + Z1Z2 + W1W2
036310 010246 MOV R2,-(SP) ;Save R2.
036312 012301 MOV (R3)+,R1 ;R1 ← LOC[arg 2]
036314 012300 MOV (R3)+,R0 ;R0 ← LOC[arg 1]
036316 170400 CLRF AC0 ;AC0 ← 0. Running total
036320 012702 000004 MOV #4,R2 ;R2 ← 4: Length of vector and weight
036324 172520 PDV1: LDF (R0)+,AC1 ;Form sum of products of all 4 terms
036326 171121 MULF (R1)+,AC1 ;
036330 172001 ADDF AC1,AC0 ;
036332 077204 SOB R2,PDV1 ;Loop until all 3 fields done.
036334 004767 176300 JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
036340 174010 STF AC0,(R0) ;Store result
036342 012602 MOV (SP)+,R2 ;Restore R2
036344 005000 CLR R0 ;Clear condition code.
036346 000207 RTS PC ;Done
;199 -- 207 microseconds
VMAG: ;Scalar ← Norm (vector)
;S ← SQRT(XX + YY+ ZZ) / W
036350 012301 MOV (R3)+,R1 ;R1 ← LOC[arg]
036352 172421 LDF (R1)+,AC0 ;AC0 ← X
036354 171000 MULF AC0,AC0 ;AC0 ← XX
036356 172521 LDF (R1)+,AC1 ;AC1 ← Y
036360 171101 MULF AC1,AC1 ;AC1 ← YY
PALX 222 04/21/75 21:12:45 PAGE 91
INTERP PAL[HAL,HE] PAGE 9.2 Interpreter
036362 172001 ADDF AC1,AC0 ;AC0 ← XX + YY
036364 172521 LDF (R1)+,AC1 ;AC1 ← Z
036366 171101 MULF AC1,AC1 ;AC1 ← ZZ
036370 172001 ADDF AC1,AC0 ;AC0 ← XX + YY + ZZ
036372 010146 MOV R1,-(SP) ;Push LOC[W] onto system stack, to save across SQRTF
VMAG+24 36374 9 104 SQRTF UNDEFINED
036374 004767 141400 JSR PC,SQRTF ;AC0 ← SQRT(XX + YY + ZZ)
036400 174436 DIVF @(SP)+,AC0 ;AC0 ← AC0 / W
036402 004767 176232 JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
036406 174010 STF AC0,(R0) ;Store answer
036410 005000 CLR R0 ;Clear condition code.
036412 000207 RTS PC ;Done
PALX 222 04/21/75 21:12:45 PAGE 92
INTERP PAL[HAL,HE] PAGE 10 Interpreter
;Vector utilities: UNITV, CROSV
;281 -- 286 microseconds *** maybe don't need this procedure
UNITV: ;Vector ← V / Norm(V)
;S ← SQRT(XX + YY+ ZZ) / W
036414 010246 MOV R2,-(SP) ;Save R2
036416 011301 MOV (R3),R1 ;R1 ← LOC[arg]
036420 172421 LDF (R1)+,AC0 ;AC0 ← X
036422 171000 MULF AC0,AC0 ;AC0 ← XX
036424 172521 LDF (R1)+,AC1 ;AC1 ← Y
036426 171101 MULF AC1,AC1 ;AC1 ← YY
036430 172001 ADDF AC1,AC0 ;AC0 ← XX + YY
036432 172521 LDF (R1)+,AC1 ;AC1 ← Z
036434 171101 MULF AC1,AC1 ;AC1 ← ZZ
036436 172001 ADDF AC1,AC0 ;AC0 ← XX + YY + ZZ
036440 010146 MOV R1,-(SP) ;Save R1 across SQRTF
UNITV+26 36442 10 17 SQRTF UNDEFINED
036442 004767 141332 JSR PC,SQRTF ;AC0 ← SQRT(XX + YY + ZZ)
036446 012601 MOV (SP)+,R1 ;Restore R1
036450 174411 DIVF (R1),AC0 ;AC0 ← Norm = SQRT / W
036452 012301 MOV (R3)+,R1 ;R1 ← LOC[arg]
036454 004767 176174 JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector block]
036460 012702 000003 MOV #3,R2 ;R2 ← count of fields
036464 172521 UNITV1: LDF (R1)+,AC1 ;AC1 ← field of vector
036466 174500 DIVF AC0,AC1 ;divide by norm
036470 174120 STF AC1,(R0)+ ;Store result
036472 077204 SOB R2,UNITV1 ;Loop until done
036474 012120 MOV (R1)+,(R0)+ ;Copy W.
036476 011110 MOV (R1),(R0) ; (two words long)
036500 012602 MOV (SP)+,R2 ;Restore R2
036502 005000 CLR R0 ;Clear condition code
036504 000207 RTS PC ;Done
;172 -- 184 microseconds *** maybe don't need this procedure
CROSV: ;Vector ← Vector cross Vector
;X ← Y1Z2 - Y2Z1
;Y ← X2Z1 - X1Z2
;Z ← X1Y2 - X2Y1
;W ← W1W2
;AC0, 1, 2, 3, 4, 5 are garbaged by this routine.
036506 010246 MOV R2,-(SP) ;Save R2
036510 011302 MOV (R3),R2 ;R2 ← LOC[arg 2]
036512 004767 176136 JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector block]
036516 016301 000004 MOV 4(R3),R1 ;R1 ← LOC[arg 1]. Must not pop R3 stack yet!
036522 172461 000014 LDF 14(R1),AC0 ;AC0 ← W1
036526 171062 000014 MULF 14(R2),AC0 ;AC0 ← W1W2
036532 174060 000014 STF AC0,14(R0) ;Store AC0 → W
036536 172461 000004 LDF 4(R1),AC0 ;AC0 ← Y1
036542 172512 LDF (R2),AC1 ;AC1 ← X2
PALX 222 04/21/75 21:12:45 PAGE 93
INTERP PAL[HAL,HE] PAGE 10.1 Interpreter
036544 172662 000004 LDF 4(R2),AC2 ;AC2 ← Y2
036550 172711 LDF (R1),AC3 ;AC3 ← X1
036552 174304 STF AC3,AC4 ;AC4 ← X1
036554 174005 STF AC0,AC5 ;AC5 ← Y1
036556 171302 MULF AC2,AC3 ;AC3 ← X1Y2
036560 171001 MULF AC1,AC0 ;AC0 ← X2Y1
036562 173300 SUBF AC0,AC3 ;AC3 ← X1Y2 - X2Y1
036564 174360 000010 STF AC3,10(R0) ;Z ← AC3
036570 172462 000010 LDF 10(R2),AC0 ;AC0 ← Z2
036574 172761 000010 LDF 10(R1),AC3 ;AC3 ← Z1
036600 171004 MULF AC4,AC0 ;AC0 ← X1Z2
036602 171103 MULF AC3,AC1 ;AC1 ← X2Z1
036604 173100 SUBF AC0,AC1 ;AC1 ← X2Z1 - X1Z2
036606 174160 000004 STF AC1,4(R0) ;Y ← AC1
036612 172462 000010 LDF 10(R2),AC0 ;AC0 ← Z2
036616 171005 MULF AC5,AC0 ;AC0 ← Y1Z2
036620 171302 MULF AC2,AC3 ;AC3 ← Y2Z1
036622 173003 SUBF AC3,AC0 ;AC0 ← Y1Z2 - Y2Z1
036624 174010 STF AC0,(R0) ;X ← AC0
036626 012363 000002 MOV (R3)+,2(R3) ;Put result cell where first argument was
036632 005723 TST (R3)+ ;Put stack pointer in right place
036634 012602 MOV (SP)+,R2 ;Restore R2
036636 005000 CLR R0 ;Clear condition code
036640 000207 RTS PC ;Done
PALX 222 04/21/75 21:12:45 PAGE 94
INTERP PAL[HAL,HE] PAGE 11 Interpreter
;Return vectors: SVMUL, TVMUL, VMAKE, VADD
;83 -- 91 microseconds
SVMUL: ;Vector ← Scalar * Vector
;X ← S*X, Y ← S*Y, Z ← S*Z, W ← W
036642 010246 MOV R2,-(SP) ;Save R2
036644 012301 MOV (R3)+,R1 ;R1 ← LOC[vector]
036646 172433 LDF @(R3)+,AC0 ;AC0 ← scalar;
036650 004767 176000 JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector block]
036654 012702 000003 MOV #3,R2 ;R2 ← 3: How many fields to handle
036660 172521 SVM1: LDF (R1)+,AC1 ;AC1 ← next field of vector
036662 171100 MULF AC0,AC1 ;AC1 ← product
036664 174120 STF AC1,(R0)+ ;Store result
036666 077204 SOB R2,SVM1 ;Loop until all 3 fields done.
036670 012120 MOV (R1)+,(R0)+ ;Transfer W
036672 012120 MOV (R1)+,(R0)+ ; which is 2 words long.
036674 012602 MOV (SP)+,R2 ;Restore R2
036676 005000 CLR R0 ;Clear condition code
036700 000207 RTS PC ;Done
VMAKE:
036702 172533 LDF @(R3)+,AC1 ;Fetch X
036704 172633 LDF @(R3)+,AC2 ;Fetch Y
036706 172733 LDF @(R3)+,AC3 ;Fetch Z
036710 004767 175740 JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector]
036714 174120 STF AC1,(R0)+ ;Store X
036716 174220 STF AC2,(R0)+ ;Store Y
036720 174320 STF AC3,(R0)+ ;Store Z
036722 016720 000164 MOV ONE,(R0)+ ;Store W
036726 005010 CLR (R0) ;Store W (second word)
036730 005000 CLR R0 ;Clear condition code
036732 000207 RTS PC ;Done
VADD:
036734 012300 MOV (R3)+,R0 ;R0 ← LOC[arg 1]
036736 012301 MOV (R3)+,R1 ;R1 ← LOC[arg 1]
036740 172520 LDF (R0)+,AC1 ;Calculate X
036742 172121 ADDF (R1)+,AC1 ;
036744 172620 LDF (R0)+,AC2 ;Calculate Y
036746 172221 ADDF (R1)+,AC2 ;
036750 172720 LDF (R0)+,AC3 ;Calculate Z
036752 172321 ADDF (R1)+,AC3 ;
036754 004767 175674 JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector]
036760 174120 STF AC1,(R0)+ ;Store X
036762 174220 STF AC2,(R0)+ ;Store Y
036764 174320 STF AC3,(R0)+ ;Store Z
036766 016720 000120 MOV ONE,(R0)+ ;Assume W is 1
036772 005010 CLR (R0) ;
036774 005000 CLR R0 ;Clear condition code
PALX 222 04/21/75 21:12:45 PAGE 95
INTERP PAL[HAL,HE] PAGE 11.1 Interpreter
036776 000207 RTS PC ;Done
;283 -- 324 microseconds
TVMUL: ;Vector ← Trans * Vector
037000 010246 MOV R2,-(SP) ;Save R2
037002 011302 MOV (R3),R2 ;R2 ← LOC[vector]
037004 016300 000002 MOV 2(R3),R0 ;R0 ← LOC[trans]
037010 170401 CLRF AC1 ;X ← 0
037012 170402 CLRF AC2 ;Y ← 0
037014 170403 CLRF AC3 ;Z ← 0
037016 012701 000004 MOV #4,R1 ;R1 ← How many columns left to go
037022 172422 TVM1: LDF (R2)+,AC0 ;AC0 ← field of vector
037024 174005 STF AC0,AC5 ;AC5 ← copy of AC0
037026 171020 MULF (R0)+,AC0 ;
037030 172100 ADDF AC0,AC1 ;Add partial result to X
037032 172405 LDF AC5,AC0 ;Restore AC0
037034 171020 MULF (R0)+,AC0 ;
037036 172200 ADDF AC0,AC2 ;Add partial result to Y
037040 172405 LDF AC5,AC0 ;Restore AC0
037042 171020 MULF (R0)+,AC0 ;
037044 172300 ADDF AC0,AC3 ;Add partial result to Z.
037046 062700 000004 ADD #4,R0 ;Skip bottom row
037052 077115 SOB R1,TVM1 ;Go back to do all 4 columns.
037054 004767 175574 JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector]
037060 174120 STF AC1,(R0)+ ;Store X
037062 174220 STF AC2,(R0)+ ;Store Y
037064 174320 STF AC3,(R0)+ ;Store Z
037066 016220 177774 MOV -4(R2),(R0)+;Copy W from the vector
037072 016210 177776 MOV -2(R2),(R0) ; (2 words long)
037076 012363 000002 MOV (R3)+,2(R3) ;Put result cell where first argument was
037102 005723 TST (R3)+ ;Put stack pointer in right place
037104 012602 MOV (SP)+,R2 ;Restore R2
037106 005000 CLR R0 ;Clear condition code
037110 000207 RTS PC ;Done
037112 040200 ONE: 40200 ;First word of floating 1.000 (second word zero)
PALX 222 04/21/75 21:12:45 PAGE 96
INTERP PAL[HAL,HE] PAGE 12 Interpreter
;Return a trans: TMAKE, TTMUL
TMAKE:
;All that is required is to take the rot part of the first argument,
;and the vector from the second part;
037114 010246 MOV R2,-(SP) ;Save R2
037116 012301 MOV (R3)+,R1 ;R1 ← LOC[arg 1]
037120 012346 MOV (R3)+,-(SP) ;Push LOC[arg 2]
037122 004767 175542 JSR PC,GETTRN ;R0 ← -(R3) ← LOC[new trans]
037126 012702 000014 MOV #14,R2 ;R2 ← Count of how many copies to make
037132 012120 TMK1: MOV (R1)+,(R0)+ ;Transfer first half of floating word
037134 012120 MOV (R1)+,(R0)+ ;Transfer second half of floating word
037136 077203 SOB R2,TMK1 ;Repeat until done
037140 012601 MOV (SP)+,R1 ;R1 ← LOC[arg 2]
037142 012702 000004 MOV #4,R2 ;R2 ← Count of how many copies to make
037146 012120 TMK2: MOV (R1)+,(R0)+ ;Transfer first half of floating word
037150 012120 MOV (R1)+,(R0)+ ;Transfer second half of floating word
037152 077203 SOB R2,TMK2 ;Repeat until done
037154 012602 MOV (SP)+,R2 ;Restore R2
037156 005000 CLR R0 ;Clear condition code.
037160 000207 RTS PC ;Done.
TTMUL:
;Multiplies two transes together. Takes advantage of the fact that
;last row is 0 0 0 1.
037162 010246 MOV R2,-(SP) ;Save R2
037164 012302 MOV (R3)+,R2 ;R2 ← LOC[arg 2]
037166 012301 MOV (R3)+,R1 ;R1 ← LOC[arg 1]
037170 004767 175474 JSR PC,GETTRN ;R0 ← -(R3) ← LOC[new trans]
037174 010346 MOV R3,-(SP) ;Save R3
037176 010446 MOV R4,-(SP) ;Save R4
037200 012704 000004 MOV #4,R4 ;Loop count for cols of answer
037204 010146 MOV R1,-(SP) ;Save a copy of R1
037206 172522 TTM2: LDF (R2)+,AC1 ;Pick up a column of arg2: First row
037210 172622 LDF (R2)+,AC2 ; Second row
037212 172722 LDF (R2)+,AC3 ; Third row
037214 174304 STF AC3,AC4 ; store in AC4
037216 062702 000004 ADD #4,R2 ; Fourth row is zero
037222 012703 000003 MOV #3,R3 ;Loop count for rows of answer
037226 172711 TTM1: LDF (R1),AC3 ;First col of arg 1
037230 171301 MULF AC1,AC3 ;
037232 172461 000020 LDF 20(R1),AC0 ;Second col of arg 1
037236 171002 MULF AC2,AC0 ;
037240 172300 ADDF AC0,AC3 ;
037242 172461 000040 LDF 40(R1),AC0 ;Third col of arg 1
037246 171004 MULF AC4,AC0 ;
037250 172300 ADDF AC0,AC3 ;
037252 174320 STF AC3,(R0)+ ;
037254 062701 000004 ADD #4,R1 ;Move to next column of arg 1
PALX 222 04/21/75 21:12:45 PAGE 97
INTERP PAL[HAL,HE] PAGE 12.1 Interpreter
037260 077316 SOB R3,TTM1 ;Repeat for first 3 rows of answer
037262 005020 CLR (R0)+ ;Last row of answer is zero
037264 005020 CLR (R0)+ ;
037266 011601 MOV (SP),R1 ;Reset R1 to point to first row of arg 1
037270 077432 SOB R4,TTM2 ;Repeat for all four columns of answer
037272 172560 177760 LDF -20(R0),AC1 ;Add correction for last column, first row
037276 172161 000060 ADDF 60(R1),AC1 ;
037302 174160 177760 STF AC1,-20(R0) ;
037306 172560 177764 LDF -14(R0),AC1 ;Add correction for last column, second row
037312 172161 000064 ADDF 64(R1),AC1 ;
037316 174160 177764 STF AC1,-14(R0) ;
037322 172560 177770 LDF -10(R0),AC1 ;Add correction for last column, third row
037326 172161 000070 ADDF 70(R1),AC1 ;
037332 174160 177770 STF AC1,-10(R0) ;
037336 016760 177550 177774 MOV ONE,-4(R0) ;Make last col, last row get a one.
037344 005726 TST (SP)+ ;Pop the R1 temp
037346 012604 MOV (SP)+,R4 ;Restore R4
037350 012603 MOV (SP)+,R3 ;Restore R3
037352 012602 MOV (SP)+,R2 ;Restore R2
037354 005000 CLR R0 ;Clear condition code
037356 000207 RTS PC ;Done
PALX 222 04/21/75 21:12:45 PAGE 98
TEST1 PAL[HAL,HE] PAGE 2.2 Interpreter
;Currently under test
INSTRT:
;.INSRT COM0.PAL[H,RF]
;.INSRT COM1.PAL[H,RF]
;.INSRT COM2.PAL[H,RF]
;.INSRT COM3.PAL[H,RF]
.INSRT COMT.PAL[H,RF]
PALX 222 04/21/75 21:12:45 PAGE 99
COMT PAL[H,RF] PAGE 1 Interpreter
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 Small test of interpreter sprouts
C00003 ENDMK
C⊗;
PALX 222 04/21/75 21:12:45 PAGE 100
COMT PAL[H,RF] PAGE 2 Interpreter
;Small test of interpreter sprouts
L10:
037360 000006 XPUSH
037362 000000 0
037364 000032 XSPROUT
037366 037400 L1
037370 037416 L2
037372 037424 L3
037374 000000 0
037376 000024 XTERMINATE
037400 000006 L1: XPUSH
037402 000001 1
037404 000032 XSPROUT
037406 037432 L4
037410 037440 L5
037412 000000 0
037414 000024 XTERMINATE
037416 000006 L2: XPUSH
037420 000002 2
037422 000024 XTERMINATE
037424 000006 L3: XPUSH
037426 000003 3
037430 000024 XTERMINATE
037432 000006 L4: XPUSH
037434 000004 4
037436 000024 XTERMINATE
037440 000006 L5: XPUSH
037442 000005 5
037444 000024 XTERMINATE
PALX 222 04/21/75 21:12:45 PAGE 101
TEST1 PAL[HAL,HE] PAGE 2.3 Interpreter
;Data areas
037546 ARG1: .BLKW 32. ;Long enough for a trans
037646 ARG2: .BLKW 32. ;Long enough for a trans
037746 RES: .BLKW 32. ;Long enough for a trans
037746 022476 CURIN: INBUF ;Current line pointer
040150 .BLKW 100 ;Stack
040152 STACK: .BLKW 1 ;
TELL ISBS
TELL2 ISBS,\ISBS
.PRINT /ISBS = /
.PRINT /10
/
040172 ISTBLK: .BLKW ISBS ;Interpreter status block
040372 ENVIRO: .BLKW 100 ;Environment
040432 INSTCK: .BLKW INSTSZ ;Interpreter Stack
PDBLK MAINBL,100,S ;Makes a process descriptor for main process
.IF NB S
100000 .W.==UFPUSE
.IF IDN <S>,<D>
.BLKW DPOFF
.W.==.W.+UDPUSE
.IFF
040532 .BLKW FPOFF
.ENDC
.IFF
.W.==0
.ENDC
.LIF NB
.W.==.W.+UFPNSV
.LIF NB
.W.==.W.+USKNSV
040532 100000 MAINBL: .WORD .W.
040576 .BLKW <USKLEN-UST0>/2-1
040576 000100 .WORD 100
041000 .BLKW 100
SYSDEF JOBDAT, MAINBL
041000 III == .
017772 . = JOBDAT
017772 040532 MAINBL
041000 . = III
SYSDEF JOBSA, START
041000 III == .
017774 . = JOBSA
017774 041616 START
041000 . = III
SYSDEF JOBPDL, STACK
PALX 222 04/21/75 21:12:45 PAGE 102
TEST1 PAL[HAL,HE] PAGE 2.4 Interpreter
041000 III == .
017776 . = JOBPDL
017776 040150 STACK
041000 . = III
PALX 222 04/21/75 21:12:45 PAGE 103
TEST1 PAL[HAL,HE] PAGE 3 Interpreter
;FLREAD, SCALIN, VECTIN, TRNSIN, SCLOUT, VECOUT, TRNOUT
;Routine to read a floating number into location pointed to by R0.
041000 010046 FLREAD: MOV R0,-(SP) ;Save arg.
041002 016700 176740 MOV CURIN,R0 ;R0 ← current line pointer
041006 004767 157162 FLRD2: JSR PC,RELSCN ;AC0 ← number typed in
041012 005701 TST R1 ;Got anything?
041014 001407 BEQ FLRD1 ;Yes.
041016 012700 022476 MOV #INBUF,R0 ;No. Prepare to read a new line.
041022 004767 160500 JSR PC,INSTR ;
041026 012700 022476 MOV #INBUF,R0 ;
041032 000765 BR FLRD2 ;
041034 010067 176706 FLRD1: MOV R0,CURIN ;New current line pointer
041040 174036 STF AC0,@(SP)+ ;Put number in desired place.
041042 000207 RTS PC ;Done
;Routine to get a scalar argument into arg1 or arg2, whichever R0 points to
SCALIN: OUTSTR SCLMES ;Say we want a scalar
041044 010046 MOV R0,-(SP) ;Save R0. Who knows what was happening in it?
041046 010146 MOV R1,-(SP) ;Save R1.
041050 012700 041100 MOV #SCLMES,R0 ;Load up the string to be output
041054 004767 156720 JSR PC,TYPSTR ;Call the string output utility routine.
041060 012601 MOV (SP)+,R1 ;Restore R1.
041062 012600 MOV (SP)+,R0 ;Restore R0.
041064 010043 MOV R0,-(R3) ;Stack the argument
041066 105077 176654 CLRB @CURIN ;Force a move to new line.
041072 004767 177702 JSR PC,FLREAD ;Read it.
041076 000207 RTS PC ;Done
SCLMES: ASCIE </SCALAR, PLEASE: />
041100 123
041101 103
041102 101
041103 114
041104 101
041105 122
041106 054
041107 040
041110 120
041111 114
041112 105
041113 101
041114 123
041115 105
041116 072
041117 040
041120 000
.ASCIZ /SCALAR, PLEASE: /
041122 .EVEN
PALX 222 04/21/75 21:12:45 PAGE 104
TEST1 PAL[HAL,HE] PAGE 3.1 Interpreter
;Routine to get a vector argument into arg1 or arg2, whichever R0 points to
041122 010246 VECTIN: MOV R2,-(SP) ;Save R2
OUTSTR VCTMES ;Say we want a vector
041124 010046 MOV R0,-(SP) ;Save R0. Who knows what was happening in it?
041126 010146 MOV R1,-(SP) ;Save R1.
041130 012700 041204 MOV #VCTMES,R0 ;Load up the string to be output
041134 004767 156640 JSR PC,TYPSTR ;Call the string output utility routine.
041140 012601 MOV (SP)+,R1 ;Restore R1.
041142 012600 MOV (SP)+,R0 ;Restore R0.
041144 010043 MOV R0,-(R3) ;Stack the destination
041146 010046 MOV R0,-(SP) ;and save a copy on the other stack, too.
041150 105077 176572 CLRB @CURIN ;Force a move to new line.
041154 012702 000004 MOV #4,R2 ;Need to read 4 scalars
041160 004767 177614 VCTIN1: JSR PC,FLREAD ;Get one
041164 011600 MOV (SP),R0 ;Retrieve location
041166 062700 000004 ADD #4,R0 ;Update location
041172 010016 MOV R0,(SP) ;Save it again
041174 077207 SOB R2,VCTIN1 ;Go back and pick up other fields
041176 005726 TST (SP)+ ;Clean off stack
041200 012602 MOV (SP)+,R2 ;Restore R2.
041202 000207 RTS PC ;Done
VCTMES: ASCIE </I NEED A VECTOR. GIVE ME 4 SCALARS, PLEASE:
/>
041204 111
041205 040
041206 116
041207 105
041210 105
041211 104
041212 040
041213 101
041214 040
041215 126
041216 105
041217 103
041220 124
041221 117
041222 122
041223 056
041224 040
041225 040
041226 107
041227 111
041230 126
041231 105
041232 040
041233 115
041234 105
041235 040
PALX 222 04/21/75 21:12:45 PAGE 105
TEST1 PAL[HAL,HE] PAGE 3.2 Interpreter
041236 064
041237 040
041240 123
041241 103
041242 101
041243 114
041244 101
041245 122
041246 123
041247 054
041250 040
041251 120
041252 114
041253 105
041254 101
041255 123
041256 105
041257 072
041260 015
041261 012 .ASCIZ /I NEED A VECTOR. GIVE ME 4 SCALARS, PLEASE:
041262 000
/
041264 .EVEN
;Routine to get a trans argument into arg1 or arg2, whichever R0 points to
041264 010246 TRNSIN: MOV R2,-(SP) ;Save R2
OUTSTR TRNMES ;Say we want a vector
041266 010046 MOV R0,-(SP) ;Save R0. Who knows what was happening in it?
041270 010146 MOV R1,-(SP) ;Save R1.
041272 012700 041344 MOV #TRNMES,R0 ;Load up the string to be output
041276 004767 156476 JSR PC,TYPSTR ;Call the string output utility routine.
041302 012601 MOV (SP)+,R1 ;Restore R1.
041304 012600 MOV (SP)+,R0 ;Restore R0.
041306 105077 176434 CLRB @CURIN ;Force a move to new line.
041312 010043 MOV R0,-(R3) ;Stack the destination
041314 010046 MOV R0,-(SP) ;and save a copy on the other stack, too.
041316 012702 000020 MOV #16.,R2 ;Need to read 16 scalars
041322 004767 177452 TRNSN1: JSR PC,FLREAD ;Get one
041326 062716 000004 ADD #4,(SP) ;Update location
041332 011600 MOV (SP),R0 ; and retrieve it.
041334 077206 SOB R2,TRNSN1 ;Go back and pick up other fields
041336 005726 TST (SP)+ ;Clean off stack
041340 012602 MOV (SP)+,R2 ;Restore R2.
041342 000207 RTS PC ;Done
TRNMES: ASCIE </I NEED A TRANS. 16 SCALARS, BY πC O L U M N S:
/>
041344 111
041345 040
041346 116
PALX 222 04/21/75 21:12:45 PAGE 106
TEST1 PAL[HAL,HE] PAGE 3.3 Interpreter
041347 105
041350 105
041351 104
041352 040
041353 101
041354 040
041355 124
041356 122
041357 101
041360 116
041361 123
041362 056
041363 040
041364 040
041365 061
041366 066
041367 040
041370 123
041371 103
041372 101
041373 114
041374 101
041375 122
041376 123
041377 054
041400 040
041401 102
041402 131
041403 040
041404 040
041405 007
041406 103
041407 040
041410 117
041411 040
041412 114
041413 040
041414 125
041415 040
041416 115
041417 040
041420 116
041421 040
041422 123
041423 072
041424 015
041425 012 .ASCIZ /I NEED A TRANS. 16 SCALARS, BY πC O L U M N S:
041426 000
/
PALX 222 04/21/75 21:12:45 PAGE 107
TEST1 PAL[HAL,HE] PAGE 3.4 Interpreter
041430 .EVEN
;Routine to print the scalar argument pointed to by R0
041430 172410 SCLOUT: LDF (R0),AC0 ;Pick up number.
041432 012700 022622 MOV #OUTBUF,R0 ;
041436 004767 157562 JSR PC,CVG ;Convert it to string
041442 012700 022622 MOV #OUTBUF,R0 ;
041446 004767 156326 JSR PC,TYPSTR ;Print it.
041452 000207 RTS PC ;Done
;Routine to print the vector argument pointed to by R0
041454 010246 VECOUT: MOV R2,-(SP) ;Save R2
041456 010346 MOV R3,-(SP) ;Save R3
041460 010002 MOV R0,R2 ;R2 ← LOC[next field]
041462 012703 000004 MOV #4,R3 ;Need to print 4 fields
041466 172422 VCOUT1: LDF (R2)+,AC0 ;Pick up a field
041470 012700 022622 MOV #OUTBUF,R0 ;
041474 004767 157524 JSR PC,CVG ;Convert it to string
041500 012700 022622 MOV #OUTBUF,R0 ;
041504 004767 156270 JSR PC,TYPSTR ;Print it.
041510 077312 SOB R3,VCOUT1 ;Do all this 4 times
041512 012603 MOV (SP)+,R3 ;Restore R3
041514 012602 MOV (SP)+,R2 ;Restore R2
041516 000207 RTS PC ;Done
;Routine to print the trans argument pointed to by R0
041520 010246 TRNOUT: MOV R2,-(SP) ;Save R2
041522 010346 MOV R3,-(SP) ;Save R3
041524 010446 MOV R4,-(SP) ;Save R4
041526 010002 MOV R0,R2 ;R2 ← LOC[next field]
041530 012704 000004 MOV #4,R4 ;Need to print 4 cols
041534 012703 000004 TNOUT2: MOV #4,R3 ;Need to print 4 rows
041540 172422 TNOUT1: LDF (R2)+,AC0 ;Pick up a field
041542 012700 022622 MOV #OUTBUF,R0 ;
041546 004767 157452 JSR PC,CVG ;Convert it to string
041552 012700 022622 MOV #OUTBUF,R0 ;
041556 004767 156216 JSR PC,TYPSTR ;Print it.
041562 077312 SOB R3,TNOUT1 ;Do all this 4 times
CRLF ;
OUTSTR CRLFX ;Carriage return, line feed.
041564 010046 MOV R0,-(SP) ;Save R0. Who knows what was happening in it?
041566 010146 MOV R1,-(SP) ;Save R1.
041570 012700 020126 MOV #CRLFX,R0 ;Load up the string to be output
041574 004767 156200 JSR PC,TYPSTR ;Call the string output utility routine.
041600 012601 MOV (SP)+,R1 ;Restore R1.
041602 012600 MOV (SP)+,R0 ;Restore R0.
041604 077425 SOB R4,TNOUT2 ;Do this for all 4 cols.
041606 012604 MOV (SP)+,R4 ;Restore R4
041610 012603 MOV (SP)+,R3 ;Restore R3
PALX 222 04/21/75 21:12:45 PAGE 108
TEST1 PAL[HAL,HE] PAGE 3.5 Interpreter
041612 012602 MOV (SP)+,R2 ;Restore R2
041614 000207 RTS PC ;Done
PALX 222 04/21/75 21:12:45 PAGE 109
TEST1 PAL[HAL,HE] PAGE 4 Interpreter
; program initialization
000040 PDBSTA == 40 ;Process Descriptor Block Status Word
000060 PDBR0 == 60 ;Where R0 is saved
000062 PDBR1 == 62 ;Where R1 is saved
000064 PDBR2 == 64 ;Where R2 is saved
000066 PDBR3 == 66 ;Where R3 is saved
000070 PDBR4 == 70 ;Where R4 is saved
000072 PDBR5 == 72 ;Where R5 is saved
000074 PDBSP == 74 ;Where SP is saved
000076 PDBPC == 76 ;Where PC is saved
000104 PDBSSV == 104 ;Process Descriptor Block Stack Save Length Word
START:
041616 012700 000016 MOV #16,R0 ;Field length
041622 012701 000010 MOV #10,R1 ;Decimal digits
041626 004767 156722 JSR PC,FORMAT ;
041632 012703 040150 MOV #STACK,R3 ;Set up argument stack
EVMAK ;-(SP) ← event
041636 104002 104002
041640 012700 000010 MOV #ISBS,R0 ;R0 ← Size (in words) of an interpreter status block
041644 004767 171254 JSR PC,GTFREE ;R0 ← LOC[new interpreter status block]
041650 005060 000010 CLR LEV(R0) ;new LEV ← 0
041654 012760 037360 000000 MOV #INSTRT,IPC(R0) ;new IPC ← interpreter start address
041662 012760 040172 000006 MOV #ENVIRO,ENV(R0) ;new ENV ← ENVIRO
041670 011660 000016 MOV (SP),EVT(R0);new EVT ← event just created.
041674 010046 MOV R0,-(SP) ;Save LOC[new interpreter status block]
041676 012700 000020 MOV #INSTSZ,R0 ;R0 ← Size needed for an interpreter stack
041702 004767 171216 JSR PC,GTFREE ;R0 ← LOC[new interpreter stack]
041706 012601 MOV (SP)+,R1 ;R1 ← LOC[new interpreter status block]
041710 010061 000002 MOV R0,STKBAS(R1) ;Store away new stack base
041714 062700 000040 ADD #2*INSTSZ,R0 ;R0 ← LOC[top of new stack] (INSTSZ is in bytes)
041720 010146 MOV R1,-(SP) ;Save R1
041722 010046 MOV R0,-(SP) ;Save R0
041724 012700 000200 MOV #200,R0 ;Room for process descriptor
041730 004767 171170 JSR PC,GTFREE ;R0 ← LOC[new process descriptor]
041734 012760 100100 000040 MOV #UFPUSE+UGPSAV,PDBSTA(R0);Use floating point, use saved registers.
041742 012760 000100 000104 MOV #100,PDBSSV(R0) ;Length of stack to be saved.
041750 012601 MOV (SP)+,R1 ;R1 ← LOC[new interpreter stack top]
041752 010160 000066 MOV R1,PDBR3(R0) ;Store away new interp stack pointer (reg 3)
041756 011660 000054 MOV (SP),PCB+PDBSTA(R0) ;Set PDB for new interp status block
041762 012660 000070 MOV (SP)+,PDBR4(R0);Store away new interp status block ptr. (reg 4)
041766 010064 000014 MOV R0,PCB(R4) ;Put PCB away in new interp. status block.
041772 010601 MOV SP,R1 ;
041774 005721 TST (R1)+ ;
041776 010160 000074 MOV R1,PDBSP(R0) ;Store away the new stack pointer (reg 6)
042002 012760 034016 000076 MOV #INTERP,PDBPC(R0);Store away the new PC
042010 062700 000040 ADD #PDBSTA,R0 ;Move R0 to the middle of the process descriptor
SCHEDU R0,#INTERP,#0,#2;Cause the new process to be started, suspended
042014 012746 000002 MOV #2,-(SP)
PALX 222 04/21/75 21:12:45 PAGE 110
TEST1 PAL[HAL,HE] PAGE 4.1 Interpreter
042020 012746 000000 MOV #0,-(SP)
042024 012746 034016 MOV #INTERP,-(SP)
042030 010046 MOV R0,-(SP)
042032 104007 104007
EVWAIT (SP) ;Wait for the return signal
042034 011646 MOV (SP),-(SP)
042036 104004 104004
042040 103021 BCC TST1 ;All well?
HALERR TSTMES ;No
042042 010046 MOV R0,-(SP) ;Save R0.
042044 010146 MOV R1,-(SP) ;Save R1.
042046 012700 020126 MOV #CRLFX,R0 ;Move to new line
042052 004767 155722 JSR PC,TYPSTR ;
042056 012700 042126 MOV #TSTMES,R0 ;Type out message
042062 004767 155712 JSR PC,TYPSTR ;
042066 012700 020131 MOV #RUGMES,R0 ;Type out RUGMES
042072 004767 155702 JSR PC,TYPSTR ;
042076 012601 MOV (SP)+,R1 ;Restore R1.
042100 012600 MOV (SP)+,R0 ;Restore R2.
042102 000003 BPT ;Breakpoint to DDT.
TST1: OUTSTR TSTME1 ;Say farewell
042104 010046 MOV R0,-(SP) ;Save R0. Who knows what was happening in it?
042106 010146 MOV R1,-(SP) ;Save R1.
042110 012700 042170 MOV #TSTME1,R0 ;Load up the string to be output
042114 004767 155660 JSR PC,TYPSTR ;Call the string output utility routine.
042120 012601 MOV (SP)+,R1 ;Restore R1.
042122 012600 MOV (SP)+,R0 ;Restore R0.
DISMIS ;Go away
042124 104000 104000
TSTMES: ASCIE /BAD RETURN FROM MAIN INTERPRETER/
042126 102
042127 101
042130 104
042131 040
042132 122
042133 105
042134 124
042135 125
042136 122
042137 116
042140 040
042141 106
042142 122
042143 117
042144 115
042145 040
042146 115
042147 101
042150 111
PALX 222 04/21/75 21:12:45 PAGE 111
TEST1 PAL[HAL,HE] PAGE 4.2 Interpreter
042151 116
042152 040
042153 111
042154 116
042155 124
042156 105
042157 122
042160 120
042161 122
042162 105
042163 124
042164 105
042165 122
042166 000
.ASCIZ /BAD RETURN FROM MAIN INTERPRETER/
042170 .EVEN
TSTME1: ASCIE /ALL DONE NOW. SEE YOU AROUND!/
042170 101
042171 114
042172 114
042173 040
042174 104
042175 117
042176 116
042177 105
042200 040
042201 116
042202 117
042203 127
042204 056
042205 040
042206 040
042207 123
042210 105
042211 105
042212 040
042213 131
042214 117
042215 125
042216 040
042217 101
042220 122
042221 117
042222 125
042223 116
042224 104
042225 041
042226 000
.ASCIZ /ALL DONE NOW. SEE YOU AROUND!/
PALX 222 04/21/75 21:12:45 PAGE 112
TEST1 PAL[HAL,HE] PAGE 4.3 Interpreter
042230 .EVEN
042430 PATCH: .BLKW 100
041616 .END START
PALX 222 04/21/75 21:12:45 PAGE 113
TEST1 PAL[HAL,HE] PAGE 4 ***SYMBOL TABLE***
AC0 000000RH FEXACT 033250 GTRG2 034510 LEV 000010H
AC1 000001RH FFOUND 033202 GTVAL 034742 LINKB 000004H
AC2 000002RH FFREE 000020H HCOR 077776 LINKF 000002H
AC3 000003RH FLOAT 000001H HELLO 034316 LSTBLK 000004H
AC4 000004RH FLRD1 041034 IBUF 000150H LSTBUF 000024H
AC5 000005RH FLRD2 041006 ICR 000004H LVARS 000010H
ARG1 037446 FLREAD 041000 IDFLAG 000000H MAINBL 040532
ARG2 037546 FLUSH 035136 II 000004H MAPRTN 000002H
BUFHDR 000010H FOR1 035450 III 041000H MARK0 006400H
CCNT 021706 FORCHK 035412 ILGINS 000010H MARK1 006401H
CDONE 020532 FORM 000004H IN2 021532 MARK2 006402H
CHANGE 000000U FORMAT 020554 IN3 021616 MARK3 006403H
CHGCOD 000002H FPOFF 000040H IN4 021656 MARK4 006404H
CHKDG 020260 FR1 033172 INBUF 022476 MARK5 006405H
CHKDN 020522 FR2 033154 INSEND 000070 MAXIDF 000030H
CHKDP 020326 FREEND 032750 INSTCK 040372 MERGR 033542
CHKEX 020366 FREEPT 022746 INSTR 021526 METH 000000H
CHKSZ 021444 FREERR 033262 INSTRT 037360 MSIGN 021716
CHNGE 035006 FREEST 022752 INSTSZ 000020H NALLOC 000026H
CLKCNT 172544 FREL 004000 INT1 034036 NEEDED 000002H
CLKS 172540 FRINER 033010 INTCPL 034066 NFER 020634
CLKSET 172542 FRINIT 032754 INTER1 034134 NFREE 000030H
CLKTRP 000104H FRINMS 033052 INTERP 034016 NMIN 000012H
COPY 035072 FRMS1 033366 INTMS1 034176 NNNN 006402H
CRLFX 020126 FRMS2 033442 INTMS2 034244 NORM 020476
CROSV 036506 FROVFL 033324 INTOPS 034374 NPCT 000014H
CURIN 037746 FRPOS 033170 INTSTS 034132 NPERB 000006H
CVE 020762 FRRET 033242 INVMRK 000004H NUM 021724
CVF 020702 FRTRY 033142 IPC 000000H NXTBUF 000000H
CVG 021224 FSLGTH 000000H ISBS 000010H NXTCHG 000000H
DATUM 000000H FSTBLK 000006H ISTBLK 040152 NXTCLC 000000H
DBS 021710 FSTBUF 000022H JMPZ1 036066 NXTEMT 104011H
DGLST 021742 GCFG 000010H JOBDAT 017772 NXTGN 000000H
DIG 021732 GETARG 034464 JOBPDL 017776 NXTMTH 000002H
DIG2 020444 GETDG 021404 JOBSA 017774 NXTSID 000016H
DIGLP 021360 GETSCA 034640 JUMP 036036 OBUF 000160H
DPOFF 000070H GETTRN 034670 JUMPZ 036050 OENV 000004H
DSLGTH 000004H GETVAL 034704 KBIR 177562 OIPC 000006H
ENV 000006H GETVEC 034654 KBIS 177560 OLDD 021736
ENVIRO 040172 GNCHGS 000014H KBOR 177566 OLDW 021734
EPRT 021136 GNCLCS 000012H KBOS 177564 OLEV 000002H
ERRTRP 000004H GNDEPS 000010H L1 037400 ONE 037112
ESIGN 021720 GNVAL 000006H L10 037360 OUTBUF 022622
EVT 000016H GTERR 034526 L2 037416 PATCH 042230
EXCN 020406 GTFREE 033124 L3 037424 PC 000007R
EXPON 021722 GTMS1 034570 L4 037432 PCB 000014H
FERM 020636 GTRG1 034520 L5 037440 PDBPC 000076H
PALX 222 04/21/75 21:12:45 PAGE 114
TEST1 PAL[HAL,HE] PAGE 4 ***SYMBOL TABLE***
PDBR0 000060H RUG 050000 TOLGE 021412 WTDP 021400
PDBR1 000062H RUGMES 020131 TRNMES 041344 WTSP 021510
PDBR2 000064H RUNE 021312 TRNOUT 041520 XCHNGE 000004H
PDBR3 000066H RUNF 021320 TRNSIN 041264 XCOPY 000012H
PDBR4 000070H SADD 036130 TRNSN1 041322 XFLUSH 000016H
PDBR5 000072H SCALIN 041044 TSLOOP 020004 XFORCH 000034H
PDBSP 000074H SCLMES 041100 TST1 042104 XGTVAL 000002H
PDBSSV 000104H SCLOUT 041430 TSTME1 042170 XJUMP 000020H
PDBSTA 000040H SDIV 036206 TSTMES 042126 XJUMPZ 000022H
PDV1 036324 SETBS 021500 TTM1 037226 XPOP 000010H
PIC2 020442 SIDCHN 000000H TTM2 037206 XPROC 000026H
PICK 020226 SIDCNT 000000H TTMUL 037162 XPRT 021170
PLEV 000002H SIDHED 000000H TVM1 037022 XPUSH 000006H
POP 035046 SIZE 000004H TVMUL 037000 XPVDOT 000056H
PRC1 035220 SLINK 000000H TYPCHR 020066 XREPLA 000014H
PRC2 035210 SMUL 036170 TYPDEC 020016 XRETUR 000030H
PRC3 035272 SNEG 036226 TYPDIG 020036 XSADD 000036H
PRC4 035234 SP 000006R TYPOCT 020026 XSDIV 000044H
PROC 035146 SPCHDR 000032H TYPOUT 020060 XSMUL 000042H
PRTF 021326 SPR1 035704 TYPRET 020124 XSNEG 000046H
PRVBUF 000002H SPR2 035464 TYPSTR 020000 XSPROU 000032H
PRVGN 000002H SPR3 035766 UDPUSE 040000H XSSUB 000040H
PS 177776 SPR4 035712 UFPNSV 020000H XSVMUL 000052H
PT 021740 SPRMES 036002 UFPSAV 000200H XTERMI 000024H
PUSH 035054 SPROUT 035454 UFPUSE 100000H XTMAKE 000066H
PVDOT 036310 SQRTF 000000U UGPSAV 000100H XTVMUL 000064H
R0 000000R SSUB 036146 UNITV 036414 XVADD 000062H
R1 000001R STA 000012H UNITV1 036464 XVARIA 000000H
R2 000002R STACK 040150 USKLEN 000044H XVDOT 000054H
R3 000003R START 041616 USKNSV 010000H XVMAG 000050H
R4 000004R STAT 021714 USKOK 000040H XVMAKE 000060H
R5 000005R STKBAS 000002H USRORG 020000H .W. 100000H
RADIX 020044 STRT11 000500 UST0 000000H
RELSCN 020174 SVM1 036660 VADD 036734
REPLAC 035114 SVMUL 036642 VARIAB 034706
RES 037646 TAG 177777H VCOUT1 041466
RETURN 035354 TAGID 177776H VCTIN1 041160
RF 000005RH TEMP 020000H VCTMES 041204
RL1 033562 TEN 022246 VDOT 036244
RLFER1 033572 TENLST 022242 VDV1 036260
RLFER2 033634 TENTH 022236 VECOUT 041454
RLFREE 033472 TERMIN 036100 VECTIN 041122
RLMS1 033676 TMAKE 037114 VMAG 036350
RLMS2 033746 TMK1 037132 VMAKE 036702
RLRET 033564 TMK2 037146 WIDTH 021730
RNORM 020352 TNOUT1 041540 WORD0 000000H
RSTFOR 020664 TNOUT2 041534 WTCH 021514
PALX 222 04/21/75 21:12:45 PAGE 115
TEST1 PAL[HAL,HE] PAGE 4 ***SYMBOL TABLE***
3 ERRORS DETECTED
1.4 WDS AVG INSN LENGTH
42 SECONDS RUN-TIME